source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORKCHK5.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: 4.3 KB
Line 
1ORKCHK5 ; slc/CLA - Support routine called by ORKCHK to do ACCEPT mode order checks ;3/6/97 9:35
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,190**;Dec 17, 1997
3 Q
4 ;
5EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE) ;perform order checking for orderable item acceptance
6 Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE",1,"I")="D"
7 ;
8 N OI,ORKDG,HL7,ODT,ORNUM,HL7NPTR,HL7NTXT,HL7NCOD,HL7LPTR,HL7LTXT,HL7LCOD
9 N OCN,DNGR,ORKMSG,ORKPDATA,ORKOCNUM
10 ;
11 S OI=$P(ORKA,"|"),ORKDG=$P(ORKA,"|",2),HL7=$P(ORKA,"|",3)
12 S ODT=$P(ORKA,"|",4),ORNUM=$P(ORKA,"|",5),ORKPDATA=$P(ORKA,"|",6)
13 S HL7NPTR=$P(HL7,U),HL7NTXT=$P(HL7,U,2),HL7NCOD=$P(HL7,U,3)
14 S HL7LPTR=$P(HL7,U,4),HL7LTXT=$P(HL7,U,5),HL7LCOD=$P(HL7,U,6)
15 I ORKDG="GMRC",'$L(ODT) S ODT=$$NOW^XLFDT ;def consult order d/t is now
16 ;
17 I $E(ORKDG,1,2)="PS" D PHARM
18 I $E(ORKDG,1,2)'="PS",($E(ORKDG,1,2)'="LR"),($L($G(OI))),($L($G(ODT))),(ORKTMODE'="ALL") D DUPOR
19 I $E(ORKDG,1,2)="LR",($L($G(OI))),($L($G(ODT))),(ORKTMODE'="ALL") D
20 .D DUPLAB
21 .D LABFREQ
22 I $E(ORKDG,1,2)'="PS" D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
23 Q
24 ;
25PHARM ;process pharmacy order checks:
26 N ORPSPKG,ORPSA,ORKDD
27 N ORALLRN,ORALLRF,ORALLRD
28 D PARAMS("ALLERGY-DRUG INTERACTION",.ORALLRN,.ORALLRF,.ORALLRD)
29 ;
30 ;dispense drug selected:
31 I $L($G(HL7LPTR)),($G(HL7LCOD)="99PSD") D
32 .D RXOCS
33 .D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
34 ;
35 ;dispense drug NOT selected, split OI into dispense drugs:
36 I '$L($G(HL7LPTR)) D
37 .S ORPSPKG=$E(ORKDG,3)
38 .I ORPSPKG="H" S ORPSPKG="X" ;change to "X" if "H"erbal/non-VA med
39 .I "IOX"[ORPSPKG D OI2DD(.ORPSA,OI,ORPSPKG)
40 .S ORKDD=0 F S ORKDD=$O(ORPSA(ORKDD)) Q:'ORKDD D
41 ..S HL7LTXT=ORPSA(ORKDD)
42 ..S HL7NPTR=$P(ORKDD,";",2)
43 ..S HL7LPTR=+ORKDD
44 ..S HL7LCOD="99PSD",HL7NCOD="99NDF"
45 ..S $P(HL7,U)=HL7NPTR,$P(HL7,U,3)=HL7NCOD
46 ..S $P(HL7,U,4)=HL7LPTR,$P(HL7,U,5)=HL7LTXT,$P(HL7,U,6)=HL7LCOD
47 ..S $P(ORKA,"|",3)=HL7 ;set these for MLM OCX call
48 ..D RXOCS
49 ..D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
50 Q
51 ;
52RXOCS ;drug-allergy interaction
53 Q:ORALLRF="D"
54 N ORKAL
55 I $L($G(HL7NPTR)),($G(HL7NCOD)="99NDF") D
56 .D RXN^ORQQAL(.ORKAL,ORKDFN,"DR",HL7NPTR,$G(HL7LPTR)) I (ORKAL>0) D
57 ..Q:$L($P(ORKAL,U,2))<1
58 ..S ORKMSG="Previous adverse reaction to: "_$P(ORKAL,U,2)
59 ..S ORKS("ORK",ORALLRD_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG
60 Q
61 ;
62OI2DD(ORPSA,OROI,ORPSPKG) ;rtn dispense drugs for a PS OI
63 N PSOI
64 Q:'$D(^ORD(101.43,OROI,0))
65 S PSOI=$P($P(^ORD(101.43,OROI,0),U,2),";")
66 Q:+$G(PSOI)<1
67 D DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)
68 Q
69 ;
70DUPOR ;duplicate orders for non-pharmacy and non-lab:
71 S OCN=0,OCN=$O(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
72 Q:+$G(OCN)<1
73 Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
74 N ORKOR S ORKOR=0
75 D DUP^ORKOR(.ORKOR,ORKDFN,OI,ODT,ORKDG) I (ORKOR>0) D
76 .S ORKOCNUM=+$P(ORKOR,U)
77 .S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
78 .S ORKMSG="Duplicate order: "_$P(ORKOR,U,2)
79 .S ORKS("ORK",DNGR_","_$G(ORNUM)_","_ORKOCNUM_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
80 Q
81 ;
82DUPLAB ;duplicate laboratory orders:
83 N ORKLR,OCI
84 S ORKLR=0,OCI=""
85 S OCN=0,OCN=$O(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
86 Q:+$G(OCN)<1
87 Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
88 S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
89 D DUP^ORKLR(.ORKLR,OI,ORKDFN,ODT,ORKPDATA)
90 F S OCI=$O(ORKLR(OCI)) Q:OCI="" D
91 .S ORKOCNUM=+$P(ORKLR(OCI),U)
92 .S ORKMSG="Duplicate order: "_$P(ORKLR(OCI),U,2)
93 .S ORKS("ORK",DNGR_","_$G(ORNUM)_","_ORKOCNUM_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
94 Q
95 ;
96LABFREQ ;lab order frequency restrictions:
97 N ORKLR,OCI
98 S ORKLR=0,OCI=""
99 S OCN=0,OCN=$O(^ORD(100.8,"B","LAB ORDER FREQ RESTRICTIONS",OCN))
100 Q:+$G(OCN)<1
101 Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
102 S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
103 D ORFREQ^ORKLR2(.ORKLR,OI,ORKDFN_";DPT(",ODT,ORKPDATA)
104 S OCI="" F S OCI=$O(ORKLR(OCI)) Q:OCI="" D
105 .S ORKMSG=$P(ORKLR(OCI),U,2)
106 .S ORKS("ORK",DNGR_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG
107 Q
108 ;
109PARAMS(ORKNAME,ORKNUM,ORKFLAG,ORKDNGR) ; get parameter values for an order chk
110 S ORKNUM=0,ORKNUM=$O(^ORD(100.8,"B",ORKNAME,ORKNUM))
111 S ORKFLAG=$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",ORKNUM,"I")
112 S ORKDNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",ORKNUM,"I")
113 Q
Note: See TracBrowser for help on using the repository browser.