OCXODSP1 ;SLC/RJS,CLA - Rule Display (Display a Rule) ;3/26/01 15:03
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
EN(OCXD0,OCXTAB,OCXRM) ;
;
N OCXD1,OCXD,OCXRD,OCXE,OCXSUB
;
S OCXTAB=+$G(OCXTAB) S:'$G(OCXD0) OCXD0=+$$DIC("^OCXS(860.2,","AEMQ") Q:'OCXD0
;
S OCXRD="" D DIQ("^OCXS(860.2,",OCXD0,.OCXRD)
F OCXSUB="C","R" S OCXD1=0 F S OCXD1=$O(^OCXS(860.2,OCXD0,OCXSUB,OCXD1)) Q:'OCXD1 D
.S OCXD(0)=OCXD0,OCXD=OCXD1 D DIQ("^OCXS(860.2,"_OCXD0_","""_OCXSUB_""",",.OCXD,.OCXRD)
;
W !
W ! D FIELD("Rule:",$G(OCXRD(860.2,OCXD0,.01,"E"))_" ("_$G(OCXRD(860.2,OCXD0,.02,"E"),"ACTIVE")_" Status)",OCXTAB,OCXRM)
;
S OCXD1=0 F S OCXD1=$O(OCXRD(860.21,OCXD1)) Q:'OCXD1 D
.N OUTSTR,OCXE
.W !
.W ! D FIELD("Rule Element Label:",$G(OCXRD(860.21,OCXD1,.01,"E")),OCXTAB,OCXRM)
.I $G(OCXRD(860.21,OCXD1,.02,"I")) D Q
..W ! D FIELD(" Expression:",$G(OCXRD(860.21,OCXD1,2,"E")),OCXTAB,OCXRM)
..I ($G(OCXRD(860.21,OCXD1,2,"E"))["|") D
...N PTR,EXPVAL,DFLD
...S EXPVAL=$G(OCXRD(860.21,OCXD1,2,"E")) F PTR=2:2:$L(EXPVAL,"|") S DFLD=$P(EXPVAL,"|",PTR) D GETDF(DFLD)
.;
.S OUTSTR=$G(OCXRD(860.21,OCXD1,1,"E"))
.W ! D FIELD(" Element:",OUTSTR,OCXTAB,OCXRM)
.S OCXE=+$G(OCXRD(860.21,OCXD1,1,"I")) I +OCXE D EN^OCXODSP2(OCXE,OCXTAB+OCXOFF,OCXRM)
;
S OCXD1=0 F S OCXD1=$O(OCXRD(860.22,OCXD1)) Q:'OCXD1 D
.N EXPVAL,DFLD,PTR S DFLD=""
.W !
.W ! D FIELD("Relation Expression:",$G(OCXRD(860.22,OCXD1,1,"E")),OCXTAB,OCXRM)
.I $D(OCXRD(860.22,OCXD1,2,"E")) W ! D FIELD(" Order Check:",$G(OCXRD(860.22,OCXD1,2,"E")),OCXTAB,OCXRM)
.I $D(OCXRD(860.22,OCXD1,3,"E")) W ! D FIELD(" Notification:",$G(OCXRD(860.22,OCXD1,3,"E")),OCXTAB,OCXRM)
.I $D(OCXRD(860.22,OCXD1,4,"E")) W ! D FIELD(" Report Device:",$G(OCXRD(860.22,OCXD1,4,"E")),OCXTAB,OCXRM)
.I $D(OCXRD(860.22,OCXD1,5,"E")) W ! D FIELD(" Notification Message:",$G(OCXRD(860.22,OCXD1,5,"E")),OCXTAB,OCXRM)
.I $D(OCXRD(860.22,OCXD1,6,"E")) W ! D FIELD(" Order Check Message:",$G(OCXRD(860.22,OCXD1,6,"E")),OCXTAB,OCXRM)
.I $D(OCXRD(860.22,OCXD1,7,"E")) W ! D FIELD(" Schedule Action:",$G(OCXRD(860.22,OCXD1,7,"E")),OCXTAB,OCXRM)
.I $D(OCXRD(860.22,OCXD1,8,"E")) W ! D FIELD(" Schedule Frequency:",$G(OCXRD(860.22,OCXD1,8,"E")),OCXTAB,OCXRM)
.I $D(OCXRD(860.22,OCXD1,9,"E")) W ! D FIELD(" Execute Code:",$G(OCXRD(860.22,OCXD1,9,"E")),OCXTAB,OCXRM)
.I ($G(OCXRD(860.22,OCXD1,5,"E"))["|") S EXPVAL=$G(OCXRD(860.22,OCXD1,5,"E")) F PTR=2:2:$L(EXPVAL,"|") S DFLD=$P(EXPVAL,"|",PTR) S:$L(DFLD) DFLD(DFLD)=""
.I ($G(OCXRD(860.22,OCXD1,6,"E"))["|") S EXPVAL=$G(OCXRD(860.22,OCXD1,6,"E")) F PTR=2:2:$L(EXPVAL,"|") S DFLD=$P(EXPVAL,"|",PTR) S:$L(DFLD) DFLD(DFLD)=""
.S DFLD="" F S DFLD=$O(DFLD(DFLD)) Q:'$L(DFLD) D GETDF(DFLD)
;
Q
;
;
GETDF(DFLD) ;
;
N DFLDN,DCONT,DELEM,DELEMN
I (DFLD[".") D Q
.S DELEM=$P(DFLD,".",1),DFLD=$P(DFLD,".",2)
.S DFLDN=$O(^OCXS(860.4,"C",DFLD,0))
.I 'DFLDN S DFLDN=0 F S DFLDN=$O(^OCXS(860.4,"B",$E(DFLD,1,30),DFLDN)) Q:'DFLDN Q:($P(^OCXS(860.4,DFLDN,0),U,1)=DFLD)
.S DELEMN=0 F S DELEMN=$O(OCXRD(860.21,DELEMN)) Q:'DELEMN Q:(OCXRD(860.21,DELEMN,.01,"E")=DELEM)
.Q:'DELEMN S DELEM=+$G(OCXRD(860.21,DELEMN,1,"I")) Q:'DELEM
.S DCONT=+$P($G(^OCXS(860.3,DELEM,0)),U,2) Q:'DCONT
.D EN^OCXODSP3(DFLDN,OCXTAB+OCXOFF,OCXRM,DCONT)
;
I '(DFLD[".") D
.S DFLDN=$O(^OCXS(860.4,"C",DFLD,0))
.I 'DFLDN S DFLDN=0 F S DFLDN=$O(^OCXS(860.4,"B",$E(DFLD,1,30),DFLDN)) Q:'DFLDN Q:($P(^OCXS(860.4,DFLDN,0),U,1)=DFLD)
.S DELEMN=0 F S DELEMN=$O(OCXRD(860.21,DELEMN)) Q:'DELEMN D
..S DELEM=+$G(OCXRD(860.21,DELEMN,1,"I")) Q:'DELEM
..S DCONT=+$P($G(^OCXS(860.3,DELEM,0)),U,2) Q:'DCONT
..S DCONT(DCONT)=""
.S DCONT=0 F S DCONT=$O(DCONT(DCONT)) Q:'DCONT D EN^OCXODSP3(DFLDN,OCXTAB+OCXOFF,OCXRM,DCONT)
;
Q
;
FIELD(TITLE,STRING,TAB,MARGIN) ;
;
W ?TAB,TITLE
;
N PTR,SUBSTR,STRLEN
;
S STRLEN=MARGIN-($L(TITLE)+TAB)-5
S SUBSTR="" F PTR=1:1:$L(STRING," ") D
.I ($L(SUBSTR)>STRLEN) W ?(TAB+$L(TITLE)+1),SUBSTR W:$L($P(STRING," ",PTR+1)) ! S SUBSTR=""
.S:$L(SUBSTR) SUBSTR=SUBSTR_" " S SUBSTR=SUBSTR_$P(STRING," ",PTR)
W:$L(SUBSTR) ?(TAB+$L(TITLE)+1),SUBSTR
Q
;
DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR) ;
;
N DIC,X,Y
S DIC=$G(OCXDIC) Q:'$L(DIC) -1
S DIC(0)=$G(OCXDIC0) S:$L($G(OCXX)) X=OCXX
S:$L($G(OCXDICS)) DIC("S")=OCXDICS
S:$L($G(OCXDICA)) DIC("A")=OCXDICA
S:$L($G(OCXDR)) DIC("DR")=OCXDR
D ^DIC Q:(Y<1) 0 Q Y
;
;
DIQ(DIC,DA,OCXARY) ;
;
N DR,DIQ S DR=".01:99999",DIQ="OCXARY(",DIQ(0)="IEN" D EN^DIQ1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXODSP1 4683 printed Apr 09, 2024@21:34:26 Page 2
OCXODSP1 ;SLC/RJS,CLA - Rule Display (Display a Rule) ;3/26/01 15:03
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
EN(OCXD0,OCXTAB,OCXRM) ;
+1 ;
+2 NEW OCXD1,OCXD,OCXRD,OCXE,OCXSUB
+3 ;
+4 SET OCXTAB=+$GET(OCXTAB)
if '$GET(OCXD0)
SET OCXD0=+$$DIC("^OCXS(860.2,","AEMQ")
if 'OCXD0
QUIT
+5 ;
+6 SET OCXRD=""
DO DIQ("^OCXS(860.2,",OCXD0,.OCXRD)
+7 FOR OCXSUB="C","R"
SET OCXD1=0
FOR
SET OCXD1=$ORDER(^OCXS(860.2,OCXD0,OCXSUB,OCXD1))
if 'OCXD1
QUIT
Begin DoDot:1
+8 SET OCXD(0)=OCXD0
SET OCXD=OCXD1
DO DIQ("^OCXS(860.2,"_OCXD0_","""_OCXSUB_""",",.OCXD,.OCXRD)
End DoDot:1
+9 ;
+10 WRITE !
+11 WRITE !
DO FIELD("Rule:",$GET(OCXRD(860.2,OCXD0,.01,"E"))_" ("_$GET(OCXRD(860.2,OCXD0,.02,"E"),"ACTIVE")_" Status)",OCXTAB,OCXRM)
+12 ;
+13 SET OCXD1=0
FOR
SET OCXD1=$ORDER(OCXRD(860.21,OCXD1))
if 'OCXD1
QUIT
Begin DoDot:1
+14 NEW OUTSTR,OCXE
+15 WRITE !
+16 WRITE !
DO FIELD("Rule Element Label:",$GET(OCXRD(860.21,OCXD1,.01,"E")),OCXTAB,OCXRM)
+17 IF $GET(OCXRD(860.21,OCXD1,.02,"I"))
Begin DoDot:2
+18 WRITE !
DO FIELD(" Expression:",$GET(OCXRD(860.21,OCXD1,2,"E")),OCXTAB,OCXRM)
+19 IF ($GET(OCXRD(860.21,OCXD1,2,"E"))["|")
Begin DoDot:3
+20 NEW PTR,EXPVAL,DFLD
+21 SET EXPVAL=$GET(OCXRD(860.21,OCXD1,2,"E"))
FOR PTR=2:2:$LENGTH(EXPVAL,"|")
SET DFLD=$PIECE(EXPVAL,"|",PTR)
DO GETDF(DFLD)
End DoDot:3
End DoDot:2
QUIT
+22 ;
+23 SET OUTSTR=$GET(OCXRD(860.21,OCXD1,1,"E"))
+24 WRITE !
DO FIELD(" Element:",OUTSTR,OCXTAB,OCXRM)
+25 SET OCXE=+$GET(OCXRD(860.21,OCXD1,1,"I"))
IF +OCXE
DO EN^OCXODSP2(OCXE,OCXTAB+OCXOFF,OCXRM)
End DoDot:1
+26 ;
+27 SET OCXD1=0
FOR
SET OCXD1=$ORDER(OCXRD(860.22,OCXD1))
if 'OCXD1
QUIT
Begin DoDot:1
+28 NEW EXPVAL,DFLD,PTR
SET DFLD=""
+29 WRITE !
+30 WRITE !
DO FIELD("Relation Expression:",$GET(OCXRD(860.22,OCXD1,1,"E")),OCXTAB,OCXRM)
+31 IF $DATA(OCXRD(860.22,OCXD1,2,"E"))
WRITE !
DO FIELD(" Order Check:",$GET(OCXRD(860.22,OCXD1,2,"E")),OCXTAB,OCXRM)
+32 IF $DATA(OCXRD(860.22,OCXD1,3,"E"))
WRITE !
DO FIELD(" Notification:",$GET(OCXRD(860.22,OCXD1,3,"E")),OCXTAB,OCXRM)
+33 IF $DATA(OCXRD(860.22,OCXD1,4,"E"))
WRITE !
DO FIELD(" Report Device:",$GET(OCXRD(860.22,OCXD1,4,"E")),OCXTAB,OCXRM)
+34 IF $DATA(OCXRD(860.22,OCXD1,5,"E"))
WRITE !
DO FIELD(" Notification Message:",$GET(OCXRD(860.22,OCXD1,5,"E")),OCXTAB,OCXRM)
+35 IF $DATA(OCXRD(860.22,OCXD1,6,"E"))
WRITE !
DO FIELD(" Order Check Message:",$GET(OCXRD(860.22,OCXD1,6,"E")),OCXTAB,OCXRM)
+36 IF $DATA(OCXRD(860.22,OCXD1,7,"E"))
WRITE !
DO FIELD(" Schedule Action:",$GET(OCXRD(860.22,OCXD1,7,"E")),OCXTAB,OCXRM)
+37 IF $DATA(OCXRD(860.22,OCXD1,8,"E"))
WRITE !
DO FIELD(" Schedule Frequency:",$GET(OCXRD(860.22,OCXD1,8,"E")),OCXTAB,OCXRM)
+38 IF $DATA(OCXRD(860.22,OCXD1,9,"E"))
WRITE !
DO FIELD(" Execute Code:",$GET(OCXRD(860.22,OCXD1,9,"E")),OCXTAB,OCXRM)
+39 IF ($GET(OCXRD(860.22,OCXD1,5,"E"))["|")
SET EXPVAL=$GET(OCXRD(860.22,OCXD1,5,"E"))
FOR PTR=2:2:$LENGTH(EXPVAL,"|")
SET DFLD=$PIECE(EXPVAL,"|",PTR)
if $LENGTH(DFLD)
SET DFLD(DFLD)=""
+40 IF ($GET(OCXRD(860.22,OCXD1,6,"E"))["|")
SET EXPVAL=$GET(OCXRD(860.22,OCXD1,6,"E"))
FOR PTR=2:2:$LENGTH(EXPVAL,"|")
SET DFLD=$PIECE(EXPVAL,"|",PTR)
if $LENGTH(DFLD)
SET DFLD(DFLD)=""
+41 SET DFLD=""
FOR
SET DFLD=$ORDER(DFLD(DFLD))
if '$LENGTH(DFLD)
QUIT
DO GETDF(DFLD)
End DoDot:1
+42 ;
+43 QUIT
+44 ;
+45 ;
GETDF(DFLD) ;
+1 ;
+2 NEW DFLDN,DCONT,DELEM,DELEMN
+3 IF (DFLD[".")
Begin DoDot:1
+4 SET DELEM=$PIECE(DFLD,".",1)
SET DFLD=$PIECE(DFLD,".",2)
+5 SET DFLDN=$ORDER(^OCXS(860.4,"C",DFLD,0))
+6 IF 'DFLDN
SET DFLDN=0
FOR
SET DFLDN=$ORDER(^OCXS(860.4,"B",$EXTRACT(DFLD,1,30),DFLDN))
if 'DFLDN
QUIT
if ($PIECE(^OCXS(860.4,DFLDN,0),U,1)=DFLD)
QUIT
+7 SET DELEMN=0
FOR
SET DELEMN=$ORDER(OCXRD(860.21,DELEMN))
if 'DELEMN
QUIT
if (OCXRD(860.21,DELEMN,.01,"E")=DELEM)
QUIT
+8 if 'DELEMN
QUIT
SET DELEM=+$GET(OCXRD(860.21,DELEMN,1,"I"))
if 'DELEM
QUIT
+9 SET DCONT=+$PIECE($GET(^OCXS(860.3,DELEM,0)),U,2)
if 'DCONT
QUIT
+10 DO EN^OCXODSP3(DFLDN,OCXTAB+OCXOFF,OCXRM,DCONT)
End DoDot:1
QUIT
+11 ;
+12 IF '(DFLD[".")
Begin DoDot:1
+13 SET DFLDN=$ORDER(^OCXS(860.4,"C",DFLD,0))
+14 IF 'DFLDN
SET DFLDN=0
FOR
SET DFLDN=$ORDER(^OCXS(860.4,"B",$EXTRACT(DFLD,1,30),DFLDN))
if 'DFLDN
QUIT
if ($PIECE(^OCXS(860.4,DFLDN,0),U,1)=DFLD)
QUIT
+15 SET DELEMN=0
FOR
SET DELEMN=$ORDER(OCXRD(860.21,DELEMN))
if 'DELEMN
QUIT
Begin DoDot:2
+16 SET DELEM=+$GET(OCXRD(860.21,DELEMN,1,"I"))
if 'DELEM
QUIT
+17 SET DCONT=+$PIECE($GET(^OCXS(860.3,DELEM,0)),U,2)
if 'DCONT
QUIT
+18 SET DCONT(DCONT)=""
End DoDot:2
+19 SET DCONT=0
FOR
SET DCONT=$ORDER(DCONT(DCONT))
if 'DCONT
QUIT
DO EN^OCXODSP3(DFLDN,OCXTAB+OCXOFF,OCXRM,DCONT)
End DoDot:1
+20 ;
+21 QUIT
+22 ;
FIELD(TITLE,STRING,TAB,MARGIN) ;
+1 ;
+2 WRITE ?TAB,TITLE
+3 ;
+4 NEW PTR,SUBSTR,STRLEN
+5 ;
+6 SET STRLEN=MARGIN-($LENGTH(TITLE)+TAB)-5
+7 SET SUBSTR=""
FOR PTR=1:1:$LENGTH(STRING," ")
Begin DoDot:1
+8 IF ($LENGTH(SUBSTR)>STRLEN)
WRITE ?(TAB+$LENGTH(TITLE)+1),SUBSTR
if $LENGTH($PIECE(STRING," ",PTR+1))
WRITE !
SET SUBSTR=""
+9 if $LENGTH(SUBSTR)
SET SUBSTR=SUBSTR_" "
SET SUBSTR=SUBSTR_$PIECE(STRING," ",PTR)
End DoDot:1
+10 if $LENGTH(SUBSTR)
WRITE ?(TAB+$LENGTH(TITLE)+1),SUBSTR
+11 QUIT
+12 ;
DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR) ;
+1 ;
+2 NEW DIC,X,Y
+3 SET DIC=$GET(OCXDIC)
if '$LENGTH(DIC)
QUIT -1
+4 SET DIC(0)=$GET(OCXDIC0)
if $LENGTH($GET(OCXX))
SET X=OCXX
+5 if $LENGTH($GET(OCXDICS))
SET DIC("S")=OCXDICS
+6 if $LENGTH($GET(OCXDICA))
SET DIC("A")=OCXDICA
+7 if $LENGTH($GET(OCXDR))
SET DIC("DR")=OCXDR
+8 DO ^DIC
if (Y<1)
QUIT 0
QUIT Y
+9 ;
+10 ;
DIQ(DIC,DA,OCXARY) ;
+1 ;
+2 NEW DR,DIQ
SET DR=".01:99999"
SET DIQ="OCXARY("
SET DIQ(0)="IEN"
DO EN^DIQ1
+3 QUIT
+4 ;
