- 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
- ;
- 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 ;
