source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPD.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.1 KB
Line 
1OCXOCMPD ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments cont...) ;3/22/01 09:38
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5EN() ;
6 ;
7 N OCXELE,OCXD0,OCXD1,OCXD2
8 ;
9 S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"RULE",OCXD0)) Q:'OCXD0 D Q:OCXWARN
10 .N OCXR M OCXR=^OCXS(860.2,OCXD0)
11 .S OCXD1=0 F S OCXD1=$O(^TMP("OCXCMP",$J,"RULE",OCXD0,OCXD1)) Q:'OCXD1 S OCXCODE=$G(^(OCXD1)) I $L(OCXCODE) D
12 ..N OCXNMSG,OCXCMSG,OCXNTF,OCXNOD0,OCXL,OCXD2,OCXCNT,OCXVAR,OCXCODE,OCXMCOD
13 ..S OCXLA="R"_OCXD0_"R"_OCXD1_"A",OCXLB="R"_OCXD0_"R"_OCXD1_"B"
14 ..S OCXCODE=" D ||LINE:"_$$LINE^OCXOCMP4(OCXLA)_"||"
15 ..;
16 ..S OCXD2=0 F OCXCNT=0:1 S OCXD2=$O(^TMP("OCXCMP",$J,"RULE",OCXD0,OCXD1,OCXD2)) Q:'OCXD2 D
17 ...I '$D(OCXELE(OCXD2)) D
18 ....I $G(OCXTRACE) D IN^OCXOCMP4("EL"_OCXD2," W:$G(OCXTRACE) !,||LNTAG||,?27,""Element Check for: ("_OCXD2_") '"_$P(^OCXS(860.3,OCXD2,0),U,1)_"'""")
19 ....I $G(OCXTRACE) D IN^OCXOCMP4("EL"_OCXD2," ;")
20 ....S OCXELE(OCXD2)=""
21 ...D IN^OCXOCMP4("EL"_OCXD2,OCXCODE_" ; Check Relation #"_(+OCXD1)_" in Rule #"_(+OCXD0)_" '"_$P(OCXR(0),U,1)_"'")
22 ..;
23 ..D IN^OCXOCMP4(OCXLA," Q:$G(^OCXS(860.2,"_OCXD0_",""INACT""))")
24 ..D IN^OCXOCMP4(OCXLA," ;")
25 ..S OCXD2=0 F S OCXD2=$O(^TMP("OCXCMP",$J,"RULE",OCXD0,OCXD1,"CODE",OCXD2)) Q:'OCXD2 S OCXCODE=$G(^(OCXD2)) D
26 ...F Q:'(OCXCODE["@@@@") S OCXCODE=$P(OCXCODE,"@@@@",1)_"||LINE:"_$$LINE^OCXOCMP4(OCXLB)_"||"_$P(OCXCODE,"@@@@",2,999)
27 ...D IN^OCXOCMP4(OCXLA," "_OCXCODE)
28 ..;
29 ..S OCXNOD0=$G(OCXR("R",OCXD1,0))
30 ..S OCXNMSG=$G(OCXR("R",OCXD1,"MSG")) S:'$P(OCXNOD0,U,3) OCXNMSG=""
31 ..S OCXCMSG=$G(OCXR("R",OCXD1,"OCMSG")) S:'$P(OCXNOD0,U,2) OCXCMSG=""
32 ..S OCXMCOD=$G(OCXR("R",OCXD1,"MCODE"))
33 ..;
34 ..I $G(OCXTRACE) D IN^OCXOCMP4(OCXLB," I $G(OCXTRACE),$D(OCXRULE("""_OCXLB_""")) W !,||LNTAG||,?27,""Rule '"_$P($G(OCXR(0)),U,1)_"' already triggered !!""")
35 ..D IN^OCXOCMP4(OCXLB," Q:$D(OCXRULE("""_OCXLB_"""))")
36 ..D IN^OCXOCMP4(OCXLB," ;")
37 ..;
38 ..I '$G(OCXAUTO) W:($X>60) ! W "."
39 ..;
40 ..I '($L(OCXCMSG)+$L(OCXNMSG)),'$L($G(OCXR("R",OCXD1,"RULE"))),'$L(OCXMCOD) D Q
41 ...D IN^OCXOCMP4(OCXLB," ; Notification and order checking disabled for this")
42 ...D IN^OCXOCMP4(OCXLB," ; rule due to no Order Check or Notification message,")
43 ...D IN^OCXOCMP4(OCXLB," ; or execute code found in the Order Check Rule File (860.2)")
44 ..;
45 ..I $L($G(OCXR("R",OCXD1,"RULE"))) D
46 ...N OCXSCH,OCXTIME
47 ...S OCXSCH=$P(OCXR("R",OCXD1,"RULE"),U,1)
48 ...S OCXTIME=$P(OCXR("R",OCXD1,"RULE"),U,2)
49 ...;
50 ...D IN^OCXOCMP4(OCXLB," ;")
51 ...I ((OCXSCH="START")!(OCXSCH="CONTINUE")) D Q
52 ....I '$L(OCXTIME) D Q
53 .....D IN^OCXOCMP4(OCXLB," ; No code generated for '"_OCXSCH_"' rule schedule.")
54 .....D IN^OCXOCMP4(OCXLB," ; Time period not defined.")
55 .....D IN^OCXOCMP4(OCXLB," ;")
56 ....I '$L($$TIME^OCXOCMPQ(OCXTIME,OCXD0,OCXD1)) D Q
57 .....D IN^OCXOCMP4(OCXLB," ; No code generated for '"_OCXSCH_"' rule schedule.")
58 .....D IN^OCXOCMP4(OCXLB," ; Invalid time period definition. -> "_OCXTIME)
59 .....D IN^OCXOCMP4(OCXLB," ;")
60 ....S OCXTIME=$$TIME^OCXOCMPQ(OCXTIME,OCXD0,OCXD1)
61 ....D IN^OCXOCMP4(OCXLB," ; Add '"_$P($G(^OCXS(860.2,OCXD0,0)),U,1)_"' rule to")
62 ....D IN^OCXOCMP4(OCXLB," ; Time Based Order Check Schedule for patient defined by 'DFN'.")
63 ....D IN^OCXOCMP4(OCXLB," ;")
64 ....D IN^OCXOCMP4(OCXLB," N OCXSDATE")
65 ....D IN^OCXOCMP4(OCXLB," S OCXSDATE=$$ADD2DATE("_OCXTIME_")")
66 ....D IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,0)=DFN")
67 ....D IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,2,0)=""^860.12D^""_OCXSDATE")
68 ....D IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,2,OCXSDATE,1,0)=""^860.121P^"_OCXD0_"""")
69 ....D IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,2,OCXSDATE,1,"_OCXD0_",0)="_OCXD0)
70 ....D IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,""TIME"","_OCXD0_",DFN,OCXSDATE,"_OCXD0_")=""""")
71 ...;
72 ...I (OCXSCH="STOP") D
73 ....D IN^OCXOCMP4(OCXLB," ; Delete all entries for rule '"_$P($G(^OCXS(860.2,OCXD0,0)),U,1)_"' from")
74 ....D IN^OCXOCMP4(OCXLB," ; Time Based Order Check Schedule for patient defined by 'DFN'.")
75 ....D IN^OCXOCMP4(OCXLB," ; ")
76 ....D IN^OCXOCMP4(OCXLB," N OCXSDATE S OCXSDATE=0 F S OCXSDATE=$O(^OCXD(860.1,DFN,2,OCXSDATE)) Q:'OCXSDATE D")
77 ....D IN^OCXOCMP4(OCXLB," .Q:'$D(^OCXD(860.1,DFN,2,OCXSDATE,1,"_OCXD0_"))")
78 ....D IN^OCXOCMP4(OCXLB," .K ^OCXD(860.1,DFN,2,OCXSDATE,1,"_OCXD0_")")
79 ....D IN^OCXOCMP4(OCXLB," .K ^OCXD(860.1,DFN,2,OCXSDATE,1,""B"","_OCXD0_","_OCXD0_")")
80 ....D IN^OCXOCMP4(OCXLB," .K ^OCXD(860.1,""TIME"","_OCXD0_",DFN,OCXSDATE,"_OCXD0_")")
81 ..;
82 ..I '($L(OCXCMSG)+$L(OCXNMSG)+$L(OCXMCOD)) Q
83 ..;
84 ..D IN^OCXOCMP4(OCXLB," N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD")
85 ..;
86 ..I $L(OCXCMSG) D I 1
87 ...S OCXCMSG=$TR(OCXCMSG,"""","""""")
88 ...S OCXCMSG=$$XLATE^OCXOCMPQ(OCXCMSG,OCXD0,OCXD1)
89 ...D IN^OCXOCMP4(OCXLB," I ($G(OCXOSRC)=""CPRS ORDER PRESCAN"") S OCXCMSG=(+OCXPSD)_""^"_(+$P(OCXNOD0,U,2))_"^^"_$S(($E(OCXCMSG,1)=""""):$E(OCXCMSG,2,$L(OCXCMSG)),1:"""_"_OCXCMSG)_" I 1")
90 ...D IN^OCXOCMP4(OCXLB," E S OCXCMSG="_OCXCMSG)
91 ..E D IN^OCXOCMP4(OCXLB," S OCXCMSG=""""")
92 ..;
93 ..S OCXNMSG=$$XLATE^OCXOCMPQ(OCXNMSG,OCXD0,OCXD1)
94 ..S OCXMCOD=$$XLATE^OCXOCMPQ(OCXMCOD,OCXD0,OCXD1,1)
95 ..D IN^OCXOCMP4(OCXLB," S OCXNMSG="_OCXNMSG)
96 ..;
97 ..S OCXWARN=$$EN^OCXOCMPG(OCXLB,OCXCNT)
98 ..;
99 ..M OCXVAR("CODE")=^TMP("OCXCMP",$J,"C CODE",$$LINE^OCXOCMP4(OCXLA))
100 ..S OCXD2=0 F S OCXD2=$O(OCXVAR("CODE",OCXD2)) Q:'OCXD2 D
101 ...N OCXD3
102 ...F OCXD3=1:1:$L(OCXVAR("CODE",OCXD2,0),"OCXLD") I +$P(OCXVAR("CODE",OCXD2,0),"OCXLD",OCXD3+1) S OCXVAR("VAR","OCXLD"_(+$P(OCXVAR("CODE",OCXD2),"OCXLD",OCXD3+1)))=""
103 ...F OCXD3=1:1:$L(OCXVAR("CODE",OCXD2,0),"OCXLV") I +$P(OCXVAR("CODE",OCXD2,0),"OCXLV",OCXD3+1) S OCXVAR("VAR","OCXLV"_(+$P(OCXVAR("CODE",OCXD2),"OCXLV",OCXD3+1)))=""
104 ...F OCXD3=1:1:$L(OCXVAR("CODE",OCXD2,0),"OCXLC") I +$P(OCXVAR("CODE",OCXD2,0),"OCXLC",OCXD3+1) S OCXVAR("VAR","OCXLC"_(+$P(OCXVAR("CODE",OCXD2),"OCXLC",OCXD3+1)))=""
105 ..S (OCXD2,OCXCODE)="" F S OCXD2=$O(OCXVAR("VAR",OCXD2)) Q:'$L(OCXD2) S:$L(OCXCODE) OCXCODE=OCXCODE_"," S OCXCODE=OCXCODE_OCXD2
106 ..I $L(OCXCODE) D IN^OCXOCMP4(OCXLA," N "_OCXCODE,"",11000),IN^OCXOCMP4(OCXLA," ;","",11000)
107 ..K OCXVAR("CODE") M OCXVAR("CODE")=^TMP("OCXCMP",$J,"C CODE",$$LINE^OCXOCMP4(OCXLA),0)
108 ;
109 Q OCXWARN
110 ;
Note: See TracBrowser for help on using the repository browser.