source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOZ13.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1OCXOZ13 ;SLC/RJS,CLA - Order Check Scan ;SEP 4,2007 at 23:12
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 ; ***************************************************************
6 ; ** Warning: This routine is automatically generated by the **
7 ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **
8 ; ** will be lost the next time the rule compiler executes. **
9 ; ***************************************************************
10 ;
11 Q
12 ;
13R71R1A ; Verify all Event/Elements of Rule #71 'OPIOID MEDICATIONS' Relation #1 'OPIOID MED ORDER AND DUP OPIOID MEDS'
14 ; Called from EL138+5^OCXOZ0I, and EL139+5^OCXOZ0I.
15 ;
16 Q:$G(OCXOERR)
17 ;
18 ; Local Extrinsic Functions
19 ; MCE138( ----------> Verify Event/Element: 'DUP OPIOID MEDS'
20 ; MCE139( ----------> Verify Event/Element: 'OPIOID MED ORDER'
21 ;
22 Q:$G(^OCXS(860.2,71,"INACT"))
23 ;
24 I $$MCE139 D
25 .I $$MCE138 D R71R1B^OCXOZ14
26 Q
27 ;
28MCE138() ; Verify Event/Element: DUP OPIOID MEDS
29 ;
30 ; OCXDF(158) -> DUPLICATE OPIOID MEDICATIONS TEXT data field
31 ; OCXDF(157) -> DUPLICATE OPIOID MEDICATIONS FLAG data field
32 ; OCXDF(37) -> PATIENT IEN data field
33 ;
34 N OCXRES
35 S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(138,37)=OCXDF(37)
36 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),138)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),138))
37 S OCXRES(138)=0,OCXDF(157)=$P($$OPIOID(OCXDF(37)),"^",1) I $L(OCXDF(157)) S OCXRES(138,157)=OCXDF(157) I (OCXDF(157))
38 E Q 0
39 S OCXDF(158)=$P($$OPIOID(OCXDF(37)),"^",2),OCXRES(138)=11 M ^TMP("OCXCHK",$J,OCXDF(37),138)=OCXRES(138)
40 Q +OCXRES(138)
41 ;
42MCE139() ; Verify Event/Element: OPIOID MED ORDER
43 ;
44 ; OCXDF(37) -> PATIENT IEN data field
45 ;
46 N OCXRES
47 S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(139,37)=OCXDF(37)
48 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),139)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),139))
49 Q 0
50 ;
51OPIOID(ORPT) ;determine if pat is receiving opioid med
52 ; rtn 1^opioid drug 1, opioid drug 2, opioid drug3, ...
53 N ORDG,ORTN,ORNUM,ORDI,ORDCLAS,ORDERS,ORTEXT,DUP,DUPI,DUPJ,DUPLEN
54 S ORDG=0,ORTN=0,DUPI=0,DUPLEN=20
55 K ^TMP("ORR",$J)
56 S ORDG=$O(^ORD(100.98,"B","RX",ORDG))
57 D EN^ORQ1(ORPT_";DPT(",ORDG,2,"","","",0,0)
58 N J,HOR,SEQ,X S J=1,HOR=0,SEQ=0
59 S HOR=$O(^TMP("ORR",$J,HOR)) Q:+HOR<1 ORTN
60 F S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1 D
61 .S X=^TMP("ORR",$J,HOR,SEQ)
62 .S ORNUM=+$P(X,";")
63 .Q:ORNUM=+$G(ORIFN) ;quit if dup med order # = current order #
64 .S ORDI=$$VALUE^ORCSAVE2(ORNUM,"DRUG")
65 .I +$G(ORDI)>0 D
66 ..S ORDCLAS=$P(^PSDRUG(ORDI,0),U,2) ;va drug class
67 ..I ($G(ORDCLAS)="CN101")!($G(ORDCLAS)="CN102") D ;opioid classes
68 ...S ORTEXT=$$FULLTEXT^ORQOR1(ORNUM)
69 ...S ORTEXT=$P(ORTEXT,U)_" ["_$P(ORTEXT,U,2)_"]"
70 ...S DUPI=DUPI+1,DUP(DUPI)=" ["_DUPI_"] "_ORTEXT
71 ...S ORTN=1
72 I DUPI>0 D
73 .S DUPLEN=$P(215/DUPI,".")
74 .F DUPJ=1:1:DUPI D
75 ..I DUPJ=1 S ORDERS=$E(DUP(DUPJ),1,DUPLEN)
76 ..E S ORDERS=ORDERS_", "_$E(DUP(DUPJ),1,DUPLEN)
77 K ^TMP("ORR",$J)
78 Q ORTN_U_$G(ORDERS)
79 ;
Note: See TracBrowser for help on using the repository browser.