source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDX1.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1ORWDX1 ; SLC/KCM/REV - Utilities for Order Dialogs ;10/14/05
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,187,195,215**;Dec 17, 1997
3 ;
4WRLST(LST,LOC) ; Return list of dialogs for writing orders
5 ; .Y(n): DlgName^ListBox Text
6WRLST1 N ANENT
7 S LOC=+$G(LOC)_";SC(" I 'LOC S LOC=""
8 S ANENT="ALL^"_LOC_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
9 D WRLSTB(.LST) Q:$D(LST)>1 ; check ORWDX WRITE ORDERS first
10 N ORX,X0,X5,ORERR,I,SEQ,IEN,DGRP,FID,TXT,TYP
11 D GETLST^XPAR(.ORX,ANENT,"ORWOR WRITE ORDERS LIST","Q",.ORERR) Q:ORERR
12 S I=0 F S I=$O(ORX(I)) Q:'I D
13 . S SEQ=+ORX(I),IEN=$P(ORX(I),U,2),X0=$G(^ORD(101.41,+IEN,0)),X5=$G(^(5))
14 . S DGRP=+$P(X0,U,5),FID=+$P(X5,U,5),TXT=$P(X5,U,4),TYP=$P(X0,U,4)
15 . S:'$L(TXT) TXT=$P(X0,U,2)
16 . I $P(X0,U,4)="M" S:'FID FID=1001
17 . S LST(SEQ)=IEN_";"_FID_";"_DGRP_";"_TYP_U_TXT
18 Q
19WRLSTB(LST) ; return menu from which Write Orders list is built
20 N MNU,SEQ,IEN,ITM,TXT,FID,DGRP,X,TYP
21 S MNU=$$GET^XPAR(ANENT,"ORWDX WRITE ORDERS LIST",1,"I") Q:'MNU
22 S SEQ=0 F S SEQ=$O(^ORD(101.41,MNU,10,"B",SEQ)) Q:'SEQ D
23 . S IEN=0 F S IEN=$O(^ORD(101.41,MNU,10,"B",SEQ,IEN)) Q:'IEN D
24 . . S X=$G(^ORD(101.41,MNU,10,IEN,0)),ITM=+$P(X,U,2),TXT=$P(X,U,4)
25 . . S X=$G(^ORD(101.41,ITM,5)),FID=+$P(X,U,5)
26 . . S X=$G(^ORD(101.41,ITM,0)),TYP=$P(X,U,4),DGRP=+$P(X,U,5)
27 . . S:'$L(TXT) TXT=$P(X,U,2)
28 . . I TYP="M" S:'FID FID=1001
29 . . S LST(SEQ)=ITM_";"_FID_";"_DGRP_";"_TYP_U_TXT
30 Q
31DELPI ; delete PI from ORDIALOG if PI = ""
32 ;Called from SAVE^ORWDX
33 N ORPI S ORPI=0
34 S ORPI=$O(^ORD(101.41,"B","OR GTX PATIENT INSTRUCTIONS",ORPI))
35 Q:'$D(ORDIALOG(ORPI))
36 I '$D(ORDIALOG(ORPI,1)) K ORDIALOG(ORPI),ORDIALOG("WP",ORPI) Q
37 N PINODE,PITX
38 S PITX="",PINODE=$G(ORDIALOG(ORPI,1))
39 S PITX=$G(@PINODE@(1,0))
40 S PITX=$TR(PITX," ","")
41 I '$L(PITX) K ORDIALOG(ORPI),ORDIALOG("WP",ORPI)
42 Q
43FNDINFO(Y,ODIEN) ;
44 N ODI,CRTM,FRM,XX
45 S FRM="",CRTM=$$NOW^XLFDT
46 F S FRM=$O(^ORD(101.43,XRF,FRM)) Q:FRM="" D
47 . S ODI=0 F S ODI=$O(^ORD(101.43,XRF,FRM,ODI)) Q:'ODI D
48 .. S XX=^ORD(101.43,XRF,FRM,ODI)
49 .. I +$P(XX,U,3),$P(XX,U,3)<CRTM Q
50 .. I ODI=ODIEN D
51 ... S NM=NM+1
52 ... I 'XX S Y(NM)=ODIEN_U_$P(XX,U,2)_U_$P(XX,U,2)
53 ... E S Y(NM)=ODIEN_U_$P(XX,U,2)_$C(9)_"<"_$P(XX,U,4)_">"_U_$P(XX,U,4)
54 Q
55DLGDEF(LST,DLG) ; Format mapping for a dlg
56 N I,IEN,ILST,X0,X2,XW S ILST=0
57 I $O(^ORD(101.41,"AB",DLG,0))>0 S DLG=$O(^ORD(101.41,"AB",DLG,0))
58 E S DLG=$O(^ORD(101.41,"B",DLG,0))
59 Q:'DLG
60 S I=0 F S I=$O(^ORD(101.41,DLG,10,I)) Q:I'>0 D
61 . S X0=$G(^ORD(101.41,DLG,10,I,0)),X2=$G(^(2)),IEN=+$P(X0,U,2)
62 . S ILST=ILST+1,LST(ILST)=U_IEN_U_$P(X2,U,1,7)
63 . I $P(X0,U,11) S $P(LST(ILST),U,11)=1
64 . S $P(LST(ILST),U)=$P($G(^ORD(101.41,IEN,1)),U,3)
65 . I $P($G(^ORD(101.41,IEN,0)),U)="OR GTX ADDITIVE" S $P(LST(ILST),U)="ADDITIVE"
66 . I $P($G(^ORD(101.41,IEN,0)),U)="OR GTX ADDL DIETS" S $P(LST(ILST),U)="ADDLDIETS"
67 . I $L($P(LST(ILST),U))=0 S $P(LST(ILST),U)="ID"_IEN
68 . I $D(^ORD(101.41,DLG,10,"DAD",IEN)) D
69 .. N SEQ,DA,CHILD S CHILD=""
70 .. S SEQ=0 F S SEQ=$O(^ORD(101.41,DLG,10,"DAD",IEN,SEQ)) Q:'SEQ D
71 ... S DA=0 F S DA=$O(^ORD(101.41,DLG,10,"DAD",IEN,SEQ,DA)) Q:'DA D
72 .... S CHILD=CHILD_+$P($G(^ORD(101.41,DLG,10,DA,0)),U,2)_"~"
73 .. S $P(LST(ILST),U,10)=CHILD
74 Q
75 ;
76CHANGE(ORLST,ORCLST,DFN) ;
77 N CATCH,CNT,INP,INPDIEN,IVM,IVMDIEN,ORIEN,ORLOC,OR3,ORDG
78 N CIEN,DIAL,TDIAL,TDIEN,UDIEN,QORDDG
79 S (INP,IVM,INPDIEN,IVMDIEN,UDIEN)=0
80 S (TDIAL,TDIEN)=0
81 S INP=$O(^ORD(101.41,"B","PSJ OR PAT OE","")) Q:INP'>0
82 S IVM=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE","")) Q:IVM'>0
83 S TDIAL=$O(^ORD(101.41,"B","OR GXTEXT WORD PROCESSING ORDE","")) Q:TDIAL'>0
84 S INPDIEN=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS","")) Q:INPDIEN'>0
85 S IVMDIEN=$O(^ORD(100.98,"B","IV MEDICATIONS","")) Q:IVMDIEN'>0
86 S UDIEN=$O(^ORD(100.98,"B","UNIT DOSE MEDICATIONS","")) Q:UDIEN'>0
87 S TIEN=$O(^ORD(100.98,"B","NURSING","")) Q:TIEN'>0
88 S CIEN=$O(^ORD(100.98,"B","CLINIC ORDERS","")) Q:CIEN'>0
89 S CNT=0 F S CNT=$O(ORCLST(CNT)) Q:CNT'>0 D
90 .S CHANGE=0
91 .S ORIEN=$P($G(ORCLST(CNT)),U),ORIEN=$P(ORIEN,";")
92 .S ORDG=$P($G(^OR(100,ORIEN,0)),U,11)
93 .I ORDG'=INPDIEN,ORDG'=IVMDIEN,ORDG'=UDIEN,ORDG'=TIEN,ORDG'=CIEN Q
94 .S ORLOC=$P($G(ORCLST(CNT)),U,2)
95 .S OR3=$G(^OR(100,ORIEN,3))
96 .S DIAL=$P(OR3,U,4)
97 .
98 .;
99 .I $P($G(^OR(100,ORIEN,0)),U,10)=(ORLOC_";SC(") D Q
100 ..;Remove treating spec. if IMO order 26.42
101 ..I $P($G(^OR(100,ORIEN,0)),U,11)=CIEN S $P(^OR(100,ORIEN,0),U,13)=""
102 .;
103 .;CHANGE PATIENT LOCATION AND PATIENT STATUS.
104 .S $P(^OR(100,ORIEN,0),U,10)=ORLOC_";SC("
105 .S $P(^OR(100,ORIEN,0),U,12)="I"
106 .;
107 .;Check for IMO orders Nursing Dialog problem
108 .S CATCH=$P($G(^OR(100,ORIEN,0)),U,11)
109 .;
110 .S $P(^OR(100,ORIEN,0),U,11)=$S(DIAL=(IVM_";ORD(101.41,"):IVMDIEN,DIAL=(INP_";ORD(101.41,"):INPDIEN,DIAL=(TDIAL_";ORD(101.41,"):TIEN,1:CATCH)
111 .;
112 .;Check for Quick Order Dialog
113 .I CATCH=$P($G(^OR(100,ORIEN,0)),U,11) D
114 ..S QORDDG=$P($G(^ORD(101.41,+DIAL,0)),U,5)
115 ..I QORDDG=UDIEN!(QORDDG=INPDIEN) S $P(^OR(100,ORIEN,0),U,11)=INPDIEN,DIAL=(INP_";ORD(101.41,") Q
116 ..I QORDDG=IVMDIEN S $P(^OR(100,ORIEN,0),U,11)=IVMDIEN,DIAL=(IVM_";ORD(101.41,") Q
117 ..I QORDDG=TIEN S $P(^OR(100,ORIEN,0),U,11)=TIEN,DIAL=(TDIAL_";ORD(101.41,") Q
118 .;
119 .;Add treating spec if Inpatient order
120 .I (DIAL=(IVM_";ORD(101.41,"))!(DIAL=(INP_";ORD(101.41,")) D
121 ..S $P(^OR(100,ORIEN,0),U,13)=+$G(^DPT(DFN,.103))
122 Q
123 ;
124STCHANGE(ORY,DFN,ORYARR) ;
125 N CNT,DONE,NODE,PHARMID,STR,STATUS
126 S ORY=0,DONE=0
127 I '$$PATCH^XPDUTL("PSS*1.0*93") Q
128 S CNT=0 F S CNT=$O(ORYARR(CNT)) Q:CNT'>0!(DONE>0) D
129 . S NODE=$G(ORYARR(CNT))
130 . S PHARMID=$P(NODE,U),STATUS=$P(NODE,U,2)
131 . I $$UP^XLFSTR(STATUS)'=$$STATUS^PSSORUTE(DFN,PHARMID) S ORY=1,DONE=1
132 Q
133DCREN(ORY,ORYARR) ;
134 N ACT,CNT,CNT1,I,OR3,ORG,ORGID,ORID,TEXT,STATUS
135 S CNT1=0
136 S CNT=0 F S CNT=$O(ORYARR(CNT)) Q:CNT'>0 D
137 .S ORGID=ORYARR(CNT)
138 .S ORID=+ORGID,ACT=$P(ORGID,";",2),TEXT=""
139 .S OR3=$G(^OR(100,ORID,3))
140 .;Make sure current order status is pending
141 .I $P($G(^ORD(100.01,$P(OR3,U,3),0)),U)'="PENDING" Q
142 .S ORG=$P($G(OR3),U,5) Q:ORG'>0
143 .;do not add original order if it is expired
144 .S STATUS=$P(^OR(100,ORG,3),U,3)
145 .I $P($G(^ORD(100.01,STATUS,0)),U)="EXPIRED" Q
146 .;make sure current order is a renewed order
147 .I $P(OR3,U,11)'=2 Q
148 .S ACT=+$P($G(^OR(100,ORG,3)),U,7)
149 .S CNT1=CNT1+1,ORY(CNT1)=ORGID_U_$P(OR3,U,5)_";"_ACT_U_TEXT
150 Q
151PATWARD(ORY,DFN) ;
152 S ORY=0
153 I $G(^DPT(DFN,.1))'="" S ORY=1
154 Q
155ISPEND(ORIFN) ;Is the order's status pending?
156 N ISPEND,PENDST,N3 S ISPEND=0
157 Q:'$D(^OR(100,+ORIFN,3))
158 S PENDST=$O(^ORD(100.01,"B","PENDING",0))
159 S N3=$G(^OR(100,+ORIFN,3))
160 I $P(N3,U,3)=PENDST S ISPEND=1
161 Q ISPEND
Note: See TracBrowser for help on using the repository browser.