- OCXOCMPG ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments cont...) ;5/08/01 10:11
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
- ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- ;
- EN(OCXL,OCXCNT) ;
- ;
- N OCXCODE,OCXVAR
- D IN^OCXOCMP4(OCXL," ;")
- S OCXCODE=""
- ;
- I $L(OCXMCOD) D
- .;
- .D IN^OCXOCMP4(OCXL," ;")
- .D IN^OCXOCMP4(OCXL," ; Run Execute Code")
- .D IN^OCXOCMP4(OCXL," ;")
- .;
- .N NEWVAL,FLDNAME,FCNT,X
- .S NEWVAL=OCXMCOD
- .F FCNT=1:1 Q:'(NEWVAL["|") S NEWVAL=$P(NEWVAL,"|",1)_"X"_FCNT_$P(NEWVAL,"|",3,$L(NEWVAL,"|"))
- .S X=NEWVAL D ^DIM
- .I '$D(X) D Q
- ..N MESG
- ..S MESG(1)="**** WARNING *****************************************************"
- ..S MESG(2)=""
- ..S MESG(3)="The Execute code: "_OCXMCOD
- ..S MESG(4)=" Rule Format: "_$G(OCXR("R",OCXD1,"MCODE"))
- ..S MESG(5)=""
- ..S MESG(6)=" In Rule: ["_(+$G(OCXD0))_"] "_$P($G(^OCXS(860.2,+$G(OCXD0),0)),U,1)
- ..S MESG(7)=" Relation: ["_(+$G(OCXD1))_"] "_$G(^OCXS(860.2,+$G(OCXD0),"R",+$G(OCXD1),"E"))
- ..S MESG(8)=""
- ..S MESG(9)=" Did not pass the mumps syntax check. The code has been disabled."
- ..S MESG(10)=" This rule may not work correctly until the code is fixed."
- ..S MESG(11)="******************************************************************"
- ..S MESG(12)=""
- ..F FCNT=1:1 Q:'$D(MESG(FCNT)) D IN^OCXOCMP4(OCXL," ;"_MESG(FCNT))
- ..F FCNT=1:1 Q:'$D(MESG(FCNT)) D MESG(MESG(FCNT))
- .;
- .D IN^OCXOCMP4(OCXL," "_OCXMCOD)
- ;
- D IN^OCXOCMP4(OCXL," Q:$G(OCXOERR)")
- I ($P(OCXNOD0,U,3)),$L(OCXNMSG) D
- .D IN^OCXOCMP4(OCXL," ;")
- .D IN^OCXOCMP4(OCXL," ; Send Notification")
- .D IN^OCXOCMP4(OCXL," ;")
- .D IN^OCXOCMP4(OCXL," S (OCXDUZ,OCXDATA)="""",OCXNUM=0")
- .D IN^OCXOCMP4(OCXL," I ($G(OCXOSRC)=""GENERIC HL7 MESSAGE ARRAY"") D")
- .D IN^OCXOCMP4(OCXL," .S OCXDATA="_$$HL7("ORC",2)_"_""|""_"_$$HL7("ORC",3))
- .D IN^OCXOCMP4(OCXL," .S OCXDATA=$TR(OCXDATA,""^"",""@""),OCXNUM=+OCXDATA")
- .D IN^OCXOCMP4(OCXL," I ($G(OCXOSRC)=""CPRS ORDER PROTOCOL"") D")
- .D IN^OCXOCMP4(OCXL," .I $P($G(OCXORD),U,3) S OCXDUZ(+$P(OCXORD,U,3))=""""")
- .D IN^OCXOCMP4(OCXL," .S OCXNUM=+$P(OCXORD,U,2)")
- .D IN^OCXOCMP4(OCXL," S:($G(OCXOSRC)=""CPRS ORDER PRESCAN"") OCXNUM=+$P(OCXPSD,""|"",5)")
- .D IN^OCXOCMP4(OCXL," S OCXRULE("""_OCXL_""")=""""")
- .D IN^OCXOCMP4(OCXL," I $$NEWRULE(DFN,OCXNUM,"_OCXD0_","_OCXD1_","_(+$P(OCXNOD0,U,3))_",OCXNMSG) D I 1")
- .D IN^OCXOCMP4(OCXL," .D:($G(OCXTRACE)<5) EN^ORB3("_(+$P(OCXNOD0,U,3))_",DFN,OCXNUM,.OCXDUZ,OCXNMSG,.OCXDATA)")
- .I $G(OCXTRACE) D
- ..D IN^OCXOCMP4(OCXL," .I $G(OCXTRACE) D I 1")
- ..D IN^OCXOCMP4(OCXL," ..N OCXANS")
- ..D IN^OCXOCMP4(OCXL," ..W !")
- ..D IN^OCXOCMP4(OCXL," ..I ($G(OCXTRACE)>5) W !,"" *** TEST MODE - Notification not sent to ORB3 ***""")
- ..D IN^OCXOCMP4(OCXL," ..E W !,"" *** Notification sent to EN^ORB3 ***""")
- ..D IN^OCXOCMP4(OCXL," ..W !,"" Notification: "_+$P(OCXNOD0,U,3)_" ("_$P(OCXNOD0,U,3)_")""")
- ..D IN^OCXOCMP4(OCXL," ..W !,"" DFN: "",DFN")
- ..D IN^OCXOCMP4(OCXL," ..W !,"" Order Number: "",OCXNUM")
- ..D IN^OCXOCMP4(OCXL," ..W !,"" Message: "",OCXNMSG")
- ..D IN^OCXOCMP4(OCXL," ..W !,"" DATA: "",OCXDATA")
- ..D IN^OCXOCMP4(OCXL," ..W !,"" OCXTRACE: "",OCXTRACE")
- ..D IN^OCXOCMP4(OCXL," ..W:$D(OCXORD) !,"" OCXORD DATA: "",OCXORD")
- ..D IN^OCXOCMP4(OCXL," ..I $L($T(LOGAL^OCXDEBUG)) D LOGAL^OCXDEBUG("_OCXD0_","_OCXD1_","_(+$P(OCXNOD0,U,3))_",DFN,OCXNUM,"""",OCXNMSG,.OCXDATA)")
- ..D IN^OCXOCMP4(OCXL," E I $G(OCXTRACE) W !,||LNTAG||,?30,""Message: Rule already triggered""")
- ;
- I ($P(OCXNOD0,U,2)),$L(OCXCMSG) D
- .D IN^OCXOCMP4(OCXL," ;")
- .D IN^OCXOCMP4(OCXL," ; Send Order Check Message")
- .D IN^OCXOCMP4(OCXL," ;")
- .D IN^OCXOCMP4(OCXL," S OCXOCMSG($O(OCXOCMSG(999999),-1)+1)=OCXCMSG")
- ;
- Q OCXWARN
- ;
- HL7(S,P) ;
- ;
- ;Q "$G(OCXODATA("""_S_""","_P_"))"
- Q "$G(^TMP(""OCXSWAP"",$J,""OCXODATA"","""_S_""","_P_"))"
- ;
- ;
- MESG(OCXX) ;
- I '$G(OCXAUTO) W !,OCXX
- I ($G(OCXAUTO)=1) D BMES^XPDUTL(.OCXX)
- Q
- ;
- OCXOCMPG ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments cont...) ;5/08/01 10:11
- +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(OCXL,OCXCNT) ;
- +1 ;
- +2 NEW OCXCODE,OCXVAR
- +3 DO IN^OCXOCMP4(OCXL," ;")
- +4 SET OCXCODE=""
- +5 ;
- +6 IF $LENGTH(OCXMCOD)
- Begin DoDot:1
- +7 ;
- +8 DO IN^OCXOCMP4(OCXL," ;")
- +9 DO IN^OCXOCMP4(OCXL," ; Run Execute Code")
- +10 DO IN^OCXOCMP4(OCXL," ;")
- +11 ;
- +12 NEW NEWVAL,FLDNAME,FCNT,X
- +13 SET NEWVAL=OCXMCOD
- +14 FOR FCNT=1:1
- IF '(NEWVAL["|")
- QUIT
- SET NEWVAL=$PIECE(NEWVAL,"|",1)_"X"_FCNT_$PIECE(NEWVAL,"|",3,$LENGTH(NEWVAL,"|"))
- +15 SET X=NEWVAL
- DO ^DIM
- +16 IF '$DATA(X)
- Begin DoDot:2
- +17 NEW MESG
- +18 SET MESG(1)="**** WARNING *****************************************************"
- +19 SET MESG(2)=""
- +20 SET MESG(3)="The Execute code: "_OCXMCOD
- +21 SET MESG(4)=" Rule Format: "_$GET(OCXR("R",OCXD1,"MCODE"))
- +22 SET MESG(5)=""
- +23 SET MESG(6)=" In Rule: ["_(+$GET(OCXD0))_"] "_$PIECE($GET(^OCXS(860.2,+$GET(OCXD0),0)),U,1)
- +24 SET MESG(7)=" Relation: ["_(+$GET(OCXD1))_"] "_$GET(^OCXS(860.2,+$GET(OCXD0),"R",+$GET(OCXD1),"E"))
- +25 SET MESG(8)=""
- +26 SET MESG(9)=" Did not pass the mumps syntax check. The code has been disabled."
- +27 SET MESG(10)=" This rule may not work correctly until the code is fixed."
- +28 SET MESG(11)="******************************************************************"
- +29 SET MESG(12)=""
- +30 FOR FCNT=1:1
- IF '$DATA(MESG(FCNT))
- QUIT
- DO IN^OCXOCMP4(OCXL," ;"_MESG(FCNT))
- +31 FOR FCNT=1:1
- IF '$DATA(MESG(FCNT))
- QUIT
- DO MESG(MESG(FCNT))
- End DoDot:2
- QUIT
- +32 ;
- +33 DO IN^OCXOCMP4(OCXL," "_OCXMCOD)
- End DoDot:1
- +34 ;
- +35 DO IN^OCXOCMP4(OCXL," Q:$G(OCXOERR)")
- +36 IF ($PIECE(OCXNOD0,U,3))
- IF $LENGTH(OCXNMSG)
- Begin DoDot:1
- +37 DO IN^OCXOCMP4(OCXL," ;")
- +38 DO IN^OCXOCMP4(OCXL," ; Send Notification")
- +39 DO IN^OCXOCMP4(OCXL," ;")
- +40 DO IN^OCXOCMP4(OCXL," S (OCXDUZ,OCXDATA)="""",OCXNUM=0")
- +41 DO IN^OCXOCMP4(OCXL," I ($G(OCXOSRC)=""GENERIC HL7 MESSAGE ARRAY"") D")
- +42 DO IN^OCXOCMP4(OCXL," .S OCXDATA="_$$HL7("ORC",2)_"_""|""_"_$$HL7("ORC",3))
- +43 DO IN^OCXOCMP4(OCXL," .S OCXDATA=$TR(OCXDATA,""^"",""@""),OCXNUM=+OCXDATA")
- +44 DO IN^OCXOCMP4(OCXL," I ($G(OCXOSRC)=""CPRS ORDER PROTOCOL"") D")
- +45 DO IN^OCXOCMP4(OCXL," .I $P($G(OCXORD),U,3) S OCXDUZ(+$P(OCXORD,U,3))=""""")
- +46 DO IN^OCXOCMP4(OCXL," .S OCXNUM=+$P(OCXORD,U,2)")
- +47 DO IN^OCXOCMP4(OCXL," S:($G(OCXOSRC)=""CPRS ORDER PRESCAN"") OCXNUM=+$P(OCXPSD,""|"",5)")
- +48 DO IN^OCXOCMP4(OCXL," S OCXRULE("""_OCXL_""")=""""")
- +49 DO IN^OCXOCMP4(OCXL," I $$NEWRULE(DFN,OCXNUM,"_OCXD0_","_OCXD1_","_(+$PIECE(OCXNOD0,U,3))_",OCXNMSG) D I 1")
- +50 DO IN^OCXOCMP4(OCXL," .D:($G(OCXTRACE)<5) EN^ORB3("_(+$PIECE(OCXNOD0,U,3))_",DFN,OCXNUM,.OCXDUZ,OCXNMSG,.OCXDATA)")
- +51 IF $GET(OCXTRACE)
- Begin DoDot:2
- +52 DO IN^OCXOCMP4(OCXL," .I $G(OCXTRACE) D I 1")
- +53 DO IN^OCXOCMP4(OCXL," ..N OCXANS")
- +54 DO IN^OCXOCMP4(OCXL," ..W !")
- +55 DO IN^OCXOCMP4(OCXL," ..I ($G(OCXTRACE)>5) W !,"" *** TEST MODE - Notification not sent to ORB3 ***""")
- +56 DO IN^OCXOCMP4(OCXL," ..E W !,"" *** Notification sent to EN^ORB3 ***""")
- +57 DO IN^OCXOCMP4(OCXL," ..W !,"" Notification: "_+$PIECE(OCXNOD0,U,3)_" ("_$PIECE(OCXNOD0,U,3)_")""")
- +58 DO IN^OCXOCMP4(OCXL," ..W !,"" DFN: "",DFN")
- +59 DO IN^OCXOCMP4(OCXL," ..W !,"" Order Number: "",OCXNUM")
- +60 DO IN^OCXOCMP4(OCXL," ..W !,"" Message: "",OCXNMSG")
- +61 DO IN^OCXOCMP4(OCXL," ..W !,"" DATA: "",OCXDATA")
- +62 DO IN^OCXOCMP4(OCXL," ..W !,"" OCXTRACE: "",OCXTRACE")
- +63 DO IN^OCXOCMP4(OCXL," ..W:$D(OCXORD) !,"" OCXORD DATA: "",OCXORD")
- +64 DO IN^OCXOCMP4(OCXL," ..I $L($T(LOGAL^OCXDEBUG)) D LOGAL^OCXDEBUG("_OCXD0_","_OCXD1_","_(+$PIECE(OCXNOD0,U,3))_",DFN,OCXNUM,"""",OCXNMSG,.OCXDATA)")
- +65 DO IN^OCXOCMP4(OCXL," E I $G(OCXTRACE) W !,||LNTAG||,?30,""Message: Rule already triggered""")
- End DoDot:2
- End DoDot:1
- +66 ;
- +67 IF ($PIECE(OCXNOD0,U,2))
- IF $LENGTH(OCXCMSG)
- Begin DoDot:1
- +68 DO IN^OCXOCMP4(OCXL," ;")
- +69 DO IN^OCXOCMP4(OCXL," ; Send Order Check Message")
- +70 DO IN^OCXOCMP4(OCXL," ;")
- +71 DO IN^OCXOCMP4(OCXL," S OCXOCMSG($O(OCXOCMSG(999999),-1)+1)=OCXCMSG")
- End DoDot:1
- +72 ;
- +73 QUIT OCXWARN
- +74 ;
- HL7(S,P) ;
- +1 ;
- +2 ;Q "$G(OCXODATA("""_S_""","_P_"))"
- +3 QUIT "$G(^TMP(""OCXSWAP"",$J,""OCXODATA"","""_S_""","_P_"))"
- +4 ;
- +5 ;
- MESG(OCXX) ;
- +1 IF '$GET(OCXAUTO)
- WRITE !,OCXX
- +2 IF ($GET(OCXAUTO)=1)
- DO BMES^XPDUTL(.OCXX)
- +3 QUIT
- +4 ;
