ROUTINE XQOR2**: Difference between revisions
From VistApedia
Jump to navigationJump to search
DavidWhitten (talk | contribs) |
DavidWhitten (talk | contribs) |
||
| (4 intermediate revisions by the same user not shown) | |||
| Line 12: | Line 12: | ||
;; ^ORD(101,D0,24)= (#24) SCREEN [E1,245K] ^ | ;; ^ORD(101,D0,24)= (#24) SCREEN [E1,245K] ^ | ||
;; saved into lvar ORNSV (used later) | ;; saved into lvar ORNSV (used later in ACT1 called from ORD+1) | ||
S ORNSV="" I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"24)"))'[0 S ORNSV=^(24) | S ORNSV="" I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"24)"))'[0 S ORNSV=^(24) | ||
; | ; | ||
| Line 18: | Line 18: | ||
=== ORD === | === ORD === | ||
;; $O loop thru ITEM Multiple most commonly in PROTOCOL FILE -- could be OPTION FILE | |||
;; ^ORD(101,D0,10,0)=^101.01PA^^ (#10) ITEM | |||
;; ^ORD(101,D0,10,D1,0)= (#.01) ITEM [1P:101] ^ (#2) MNEMONIC [2F] ^ | |||
;; ==>(#3) SEQUENCE [3N] ^ (#4) MODIFYING ACTION [4P:101] ^ | |||
;; ==>(#5) FORMAT CODE [5S] ^ (#6) DISPLAY NAME [6F] ^ | |||
;; ^ORD(101,D0,10,D1,1)= (#11) PROMPT [1F] ^ (#12) DEFAULT [2F] ^ | |||
;; ==>(#13) HELP [3F] ^ (#14) MODE [4F] ^ | |||
;; | |||
ORD S J=$O(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_")")) G:J'>0 SET | ORD S J=$O(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_")")) G:J'>0 SET | ||
;; | |||
;; Note ORNSV code screens entries in subroutine ACT1 | |||
I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",0)")) S X=^(0) I +X D:$L(ORNSV) ACT1 I $T S Y=$S(+$P(X,"^",3):+$P(X,"^",3),1:1000+J),Y(Y,J)=X | I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",0)")) S X=^(0) I +X D:$L(ORNSV) ACT1 I $T S Y=$S(+$P(X,"^",3):+$P(X,"^",3),1:1000+J),Y(Y,J)=X | ||
;; and get next one | |||
G ORD | G ORD | ||
=== SET === | === SET === | ||
SET S (I,Y)=0 | SET S (I,Y)=0 | ||
;; NOTE: @FallThru | |||
=== SET1 === | === SET1 === | ||
SET1 S Y=$O(Y(Y)) G:Y="" EX S J=0 | SET1 S Y=$O(Y(Y)) G:Y="" EX S J=0 | ||
;; NOTE: @FallThru | |||
=== SET2 === | === SET2 === | ||
SET2 S J=$O(Y(Y,J)) G:J="" SET1 | SET2 S J=$O(Y(Y,J)) G:J="" SET1 | ||
| Line 37: | Line 53: | ||
=== ACT1 === | === ACT1 === | ||
; note: caller depends on $TEST | ; note: caller depends on $TEST being set by Xecuting ORNSV | ||
;; Note context is lvars DA, DA(1) | |||
;; NOT lvars D0, D1 | |||
ACT1 N DA S DA(1)=+^TMP("XQORS",$J,XQORS,"VPT"),DA=J N J,X,Y X ORNSV | ACT1 N DA S DA(1)=+^TMP("XQORS",$J,XQORS,"VPT"),DA=J N J,X,Y X ORNSV | ||
Q | Q | ||
| Line 43: | Line 61: | ||
=== NUL === | === NUL === | ||
NUL ;From: STAK^XQOR1 | NUL ;From: STAK^XQOR1 | ||
;; if we are in the PROTOCOL file, | |||
;; then ^ORD(101,D0,26)= (#26) HEADER [E1,245K] ^ | |||
;; Xecute it | |||
;; and zero out the ITM count | |||
I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X | I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X | ||
S ^TMP("XQORS",$J,XQORS,"ITM")=0 | S ^TMP("XQORS",$J,XQORS,"ITM")=0 | ||
Q | Q | ||
=== UP === | === UP === | ||
UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") | UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") | ||
== Other == | == Other == | ||
Latest revision as of 22:32, 13 December 2020
Listing
XQOR2
XQOR2 ; SLC/KCM - Process Extended Actions, Protocols ;8/23/91 10:33 ;
;;8.0;KERNEL;;Jul 10, 1995
ACT
ACT ;From: STAK^XQOR1
;; D0 == ^TMP("XQORS",$J,XQORS,"REF")
;; ^ORD(101,D0,26)= (#26) HEADER [E1,245K] ^
;;
I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X
;; ^ORD(101,D0,24)= (#24) SCREEN [E1,245K] ^
;; saved into lvar ORNSV (used later in ACT1 called from ORD+1)
S ORNSV="" I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"24)"))'[0 S ORNSV=^(24)
;
K Y S (J,^TMP("XQORS",$J,XQORS,"ITM"))=0
ORD
;; $O loop thru ITEM Multiple most commonly in PROTOCOL FILE -- could be OPTION FILE
;; ^ORD(101,D0,10,0)=^101.01PA^^ (#10) ITEM
;; ^ORD(101,D0,10,D1,0)= (#.01) ITEM [1P:101] ^ (#2) MNEMONIC [2F] ^
;; ==>(#3) SEQUENCE [3N] ^ (#4) MODIFYING ACTION [4P:101] ^
;; ==>(#5) FORMAT CODE [5S] ^ (#6) DISPLAY NAME [6F] ^
;; ^ORD(101,D0,10,D1,1)= (#11) PROMPT [1F] ^ (#12) DEFAULT [2F] ^
;; ==>(#13) HELP [3F] ^ (#14) MODE [4F] ^
;;
ORD S J=$O(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_")")) G:J'>0 SET
;;
;; Note ORNSV code screens entries in subroutine ACT1
I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",0)")) S X=^(0) I +X D:$L(ORNSV) ACT1 I $T S Y=$S(+$P(X,"^",3):+$P(X,"^",3),1:1000+J),Y(Y,J)=X
;; and get next one
G ORD
SET
SET S (I,Y)=0
;; NOTE: @FallThru
SET1
SET1 S Y=$O(Y(Y)) G:Y="" EX S J=0
;; NOTE: @FallThru
SET2
SET2 S J=$O(Y(Y,J)) G:J="" SET1
S ^TMP("XQORS",$J,XQORS,"ITM")=^TMP("XQORS",$J,XQORS,"ITM")+1, ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"))=+Y(Y,J)_";"_$P(^TMP("XQORS",$J,XQORS,"VPT"),";",2)
S ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"IEN")=J
I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",+$P(Y(Y,J),"^",4) S ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"MA")=$P(Y(Y,J),"^",4)_^TMP("XQORS",$J,0,"FILE")
I $L($P($G(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",1)")),"^")) S ^TMP("XQORS",$J,XQORS,"PMT",$$UP($P(^(1),"^")),^TMP("XQORS",$J,XQORS,"ITM"))=""
G SET2
EX
;; kill off ORNSV ( ^ORD(101,D0,24)= (#24) SCREEN [E1,245K] ^ ) EX K ORNSV Q
ACT1
; note: caller depends on $TEST being set by Xecuting ORNSV
;; Note context is lvars DA, DA(1)
;; NOT lvars D0, D1
ACT1 N DA S DA(1)=+^TMP("XQORS",$J,XQORS,"VPT"),DA=J N J,X,Y X ORNSV
Q
NUL
NUL ;From: STAK^XQOR1
;; if we are in the PROTOCOL file,
;; then ^ORD(101,D0,26)= (#26) HEADER [E1,245K] ^
;; Xecute it
;; and zero out the ITM count
I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X
S ^TMP("XQORS",$J,XQORS,"ITM")=0
Q
UP
UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
