source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY94A.m@ 1046

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1ORY94A ;SLC/MKB -- post-install for OR*3*94 cont;07:47 AM 7 Jun 2001
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94**;Dec 17, 1997
3 ;
4EN ; -- Shell to check delayed med orders for inactive OI's
5 ;
6 N ORODG,ORGRP,ORNOW,ORPOI,ORPDD,ORPIN,ORPFT,ORPST,ORPID,ORPAD,ORQDLG,OR0,ORDIALOG,ORIT,ORDRUG,ORPSOI,ORP,ORI,ORXX
7 S ORODG=+$O(^ORD(100.98,"B","PHARMACY",0)) D DG^ORCHANG1(ORODG,"BILD",.ORGRP)
8 S ORODG=+$O(^ORD(100.98,"B","O RX",0)),ORNOW=$$NOW^XLFDT
9 S ORPOI=+$$PTR("ORDERABLE ITEM"),ORPDD=+$$PTR("DISPENSE DRUG")
10 S ORPIN=+$$PTR("INSTRUCTIONS"),ORPFT=+$$PTR("FREE TEXT")
11 S ORPST=+$$PTR("STRENGTH"),ORPID=+$$PTR("DOSE"),ORPAD=+$$PTR("ADDITIVE")
12 ; -- delayed orders conversion only
13 D QO3,BULLETIN
14 Q
15 ;
16QO3 ; -- Update inactive OI's in delayed orders, if possible
17 N ORVP,OREVT,ORIFN,OR0,OR3,ORTS,ORITM,ORPSITM,ORNEWOI
18 S ORVP=$G(^XTMP("OR94","PAT")) ;find where left off, if restarted
19 F S ORVP=$O(^OR(100,"AEVNT",ORVP)) Q:ORVP="" D
20 . S OREVT="" F S OREVT=$O(^OR(100,"AEVNT",ORVP,OREVT)) Q:OREVT="" D
21 .. S ORIFN=0 F S ORIFN=$O(^OR(100,"AEVNT",ORVP,OREVT,ORIFN)) Q:ORIFN'>0 D
22 ... S OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),ORTS=+$P(OR0,U,13)
23 ... Q:'$D(ORGRP(+$P(OR0,U,11))) Q:$P(OR3,U,3)'=10 ;PS, still delayed
24 ... S ORDRUG=$$VALUE^ORMPS2("DRUG"),ORI=0
25 ... F S ORI=$O(^OR(100,ORIFN,4.5,"ID","ORDERABLE",ORI)) Q:ORI'>0 D
26 .... S ORITM=+$G(^OR(100,ORIFN,4.5,ORI,1)) Q:ORITM'>0
27 .... S ORPSITM=+$P($G(^ORD(101.43,ORITM,0)),U,2)
28 .... S ORNEWOI=$$EN^PSSQORD(ORPSITM,ORDRUG)
29 .... I ORNEWOI>0,$P(ORNEWOI,U,2)!($P(ORNEWOI,U,3)>ORNOW) S ORNEWOI=+$O(^ORD(101.43,"ID",+ORNEWOI_";99PSP",0)) I ORNEWOI D 100 Q
30 .... S ^XTMP("ORDER",ORVP,OREVT_";"_ORTS,ORIFN)="" ;unconverted
31 . S ^XTMP("OR94","PAT")=ORVP
32 Q
33 ;
34100 ; -- update orderable item ptr in order
35 N I S ^OR(100,ORIFN,4.5,ORI,1)=ORNEWOI,ORXX=1
36 S I=$O(^OR(100,ORIFN,.1,"B",ORITM,0)) Q:I'>0
37 K ^OR(100,ORIFN,.1,"B",ORITM,I)
38 S ^OR(100,ORIFN,.1,I,0)=ORNEWOI,^OR(100,ORIFN,.1,"B",ORNEWOI,I)=""
39 Q
40 ;
41PTR(X) ; -- Return ptr to prompt OR GTX X
42 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
43 ;
44BULLETIN ; -- Send bulletin containing qo's we couldn't convert
45 N ORNOW,ORNOW90,XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,I,J,K,L,X,TS,ORD0,DIFROM
46 S ORNOW=$$NOW^XLFDT,ORNOW90=$$FMADD^XLFDT(ORNOW,90)
47 S XMDUZ="PATCH OR*3*94 CONVERSION",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
48 I '$G(DUZ) S I=$G(^XTMP("OR94","DUZ")) S:I XMY(I)=""
49 S ^TMP("ORTXT",$J,1)="The quick order conversion of patch OR*3*94 has completed."
50B1 S J=1 I $O(^XTMP("ORIT",0)) D
51 . S ^XTMP("ORIT",0)=ORNOW90_U_ORNOW_"^CPRS/POE Inactive Orderables conversion"
52 . S J=J+1,^TMP("ORTXT",$J,J)=" "
53 . S J=J+1,^TMP("ORTXT",$J,J)="The following quick orders have inactive orderable items that were"
54 . S J=J+1,^TMP("ORTXT",$J,J)="unable to be automatically replaced with active ones:"
55 . S I=0 F S I=$O(^XTMP("ORIT",I)) Q:I'>0 D
56 .. S ORD0=$G(^ORD(101.41,+I,0))
57 .. S J=J+1,^TMP("ORTXT",$J,J)=" "_$P(ORD0,U)_" ("_$P(ORD0,U,2)_")"
58B2 I $O(^XTMP("ORPSO",0)) D
59 . S ^XTMP("ORPSO",0)=ORNOW90_U_ORNOW_"^CPRS/POE Outpt Dose conversion"
60 . S J=J+1,^TMP("ORTXT",$J,J)=" "
61 . S J=J+1,^TMP("ORTXT",$J,J)="The following Outpatient Pharmacy quick orders have instructions that"
62 . S J=J+1,^TMP("ORTXT",$J,J)="were unable to be re-formatted:"
63 . S I=0 F S I=$O(^XTMP("ORPSO",I)) Q:I'>0 D
64 .. S ORD0=$G(^ORD(101.41,+I,0))
65 .. S J=J+1,^TMP("ORTXT",$J,J)=" "_$P(ORD0,U)_" ("_$P(ORD0,U,2)_")"
66B3 I $O(^XTMP("ORDER",0)) D
67 . S ^XTMP("ORDER",0)=ORNOW90_U_ORNOW_"^CPRS/POE Delayed Orders conversion"
68 . S J=J+1,^TMP("ORTXT",$J,J)=" "
69 . S J=J+1,^TMP("ORTXT",$J,J)="The following patients have delayed orders with inactive orderable items"
70 . S J=J+1,^TMP("ORTXT",$J,J)="that were unable to be automatically replaced with active ones:"
71 . S I="" F S I=$O(^XTMP("ORDER",I)) Q:I="" D ;pt
72 .. S K="" F S K=$O(^XTMP("ORDER",I,K)) Q:K="" D ;event;TS
73 ... S X=$P(K,";"),TS=+$P(K,";",2) I X="D" S X="Discharge"
74 ... E S X=$S(X="A":"Admission",X="T":"Transfer",1:"")_$S(TS:" to "_$P($G(^DIC(45.7,TS,0)),U),1:"")
75 ... S J=J+1,^TMP("ORTXT",$J,J)=" "_$P($G(^DPT(+I,0)),U)_" - "_X_":"
76 ... S L=0 F S L=+$O(^XTMP("ORDER",I,K,L)) Q:L'>0 S J=J+1,^TMP("ORTXT",$J,J)=" "_$E($G(^OR(100,L,8,1,.1,1,0)),1,64)_"..."
77 S XMSUB="PATCH OR*3*94 CONVERSION COMPLETED"
78 S XMTEXT="^TMP(""ORTXT"","_$J_"," D ^XMD
79 Q
Note: See TracBrowser for help on using the repository browser.