source: FOIAVistA/trunk/r/CARE_MANAGEMENT-ORRC/ORRCOR.m@ 810

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1ORRCOR ;SLC/MKB - OR data for CM ; 25 Jul 2003 9:31 AM
2 ;;1.0;CARE MANAGEMENT;**3**;Jul 15, 2003
3 ;
4PTUNS(ORY,ORUSR) ; -- Return list of patients with unsigned orders by ORUSR
5 ; in @ORY@(PAT) = #unsigned orders
6 ; @ORY@(PAT,"ORU:ien;act")=""
7 ; [from ORRCDPT]
8 N IDX,PAT,IFN,ACT,NUM,X
9 S ORY=$NA(^TMP($J,"ORRCORU")),IDX="^OR(100,""AS"")" K @ORY
10 F S IDX=$Q(@IDX) Q:IDX'?1"^OR(100,""AS"",".E D
11 . S PAT=+$P($P(IDX,",",3),"""",2),IFN=+$P(IDX,",",5),ACT=+$P(IDX,",",6)
12 . Q:+$P($G(^OR(100,IFN,8,ACT,0)),U,3)'=ORUSR
13 . S X=+$G(ORY(PAT)),ORY(PAT)=X+1,ORY(PAT,"ORU:"_IFN_";"_ACT)=""
14 Q
15 ;
16IDS(ORY,ORPAT,ORTYPE,ORBEG,OREND) ; -- Return order IDs for ORPAT where
17 ; ORTYPE = ORN: Active Nursing Orders (2)
18 ; ORV: Orders Unverified by Nursing (9)
19 ; in @ORY@(PAT) = #orders
20 ; @ORY@(PAT,ID)= ! if completed (for ORN), else null
21 ; [from ORRCDPT1]
22 N ORN,ORWARD,ORFLG,ORID,ORDG,ORPKG,ORLIST,ORI,ORIFN,STS,PKG,X
23 S ORY=$NA(^TMP($J,"ORRCORU")) K @ORY
24 S ORPAT=+$G(ORPAT)_";DPT(",ORTYPE=$G(ORTYPE,"ORD")
25 S ORWARD=$G(^DPT(+ORPAT,.1)) S:$L(ORWARD) ORWARD=+$O(^DIC(42,"B",ORWARD,0))
26 S ORFLG=$S(ORTYPE="ORU":11,ORTYPE="ORV":9,1:2),ORID=ORTYPE_":"
27 S ORDG=$S(ORTYPE="ORN":"NURS",1:"ALL"),ORDG=+$O(^ORD(100.98,"B",ORDG,0))
28 S ORPKG=+$O(^DIC(9.4,"C","OR",0))
29 ;S (ORBEG,OREND)="" I ORFLG=9 S OREND=$$NOW^XLFDT,ORBEG=OREND-1
30 D EN^ORQ1(ORPAT,ORDG,ORFLG,,$G(ORBEG),$G(OREND)) S (ORI,CNT)=0
31 F S ORI=+$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1 S ORIFN=^(ORI) D
32 . S STS=$P($G(^OR(100,+ORIFN,3)),U,3),PKG=+$P($G(^(0)),U,14),X=""
33 . ;I ORTYPE="ORV",STS=1,+$G(^(6))=10 Q ;changed ??
34 . I ORTYPE="ORN","^1^2^7^11^12^13^14^"[(U_STS_U)!(PKG'=ORPKG) S X="!" ;can't complete
35 . S CNT=CNT+1,@ORY@(+ORPAT,ORID_ORIFN)=X
36 S:CNT @ORY@(+ORPAT)=CNT K ^TMP("ORR",$J,ORLIST)
37 ;if ORTYPE=ORN also get all other GEN TEXT ORDERS not in NURSING display group
38 Q:ORTYPE'="ORN"
39 S ORDG="CLINIC ORDERS",ORDG=+$O(^ORD(100.98,"B",ORDG,0))
40 D EN^ORQ1(ORPAT,ORDG,ORFLG,,$G(ORBEG),$G(OREND))
41 S ORI=0 F S ORI=+$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1 D
42 . S ORIFN=$G(^TMP("ORR",$J,ORLIST,ORI))
43 . S STS=$P($G(^OR(100,+ORIFN,3)),U,3),PKG=+$P($G(^(0)),U,14),X=""
44 . I ORTYPE="ORN","^1^2^7^11^12^13^14^"[(U_STS_U)!(PKG'=ORPKG) S X="!" ;can't complete
45 . Q:(PKG'=ORPKG)
46 . S CNT=CNT+1,@ORY@(+ORPAT,ORID_ORIFN)=X
47 S:CNT @ORY@(+ORPAT)=CNT K ^TMP("ORR",$J,ORLIST)
48 Q
49 ;
50LISTUNS(ORY,ORUSR,ORPAT,ORDET) ; -- Return unsigned orders by ORUSR for ORPAT
51 ; in @ORY@(#) = Item=ID^Text^OrderDate in HL7 format
52 ; = Order=line of order text, and also if ORDET
53 ; = Text=line of report text
54 ; [from LIST^ORRCSIG]
55 N ORN,ORDT,ORIFN,ORACT,ORID,ORRCTX,I
56 S ORY=$NA(^TMP($J,"ORRCORD")) K @ORY
57 S ORUSR=+$G(ORUSR),ORPAT=+$G(ORPAT)_";DPT(",ORN=0
58 S ORDT=0 F S ORDT=+$O(^OR(100,"AS",ORPAT,ORDT)) Q:ORDT<1 D
59 . S ORIFN=0 F S ORIFN=+$O(^OR(100,"AS",ORPAT,ORDT,ORIFN)) Q:ORIFN<1 D
60 .. S ORACT=0 F S ORACT=+$O(^OR(100,"AS",ORPAT,ORDT,ORIFN,ORACT)) Q:ORACT<1 D
61 ... Q:+$P($G(^OR(100,ORIFN,8,ORACT,0)),U,3)'=ORUSR S ORID=ORIFN_";"_ORACT
62 ... D TEXT^ORQ12(.ORRCTX,ORID,200)
63 ... S ORN=ORN+1,@ORY@(ORN)="Item=ORU:"_ORID_U_$$TXT1_U_$$FMTHL7^XLFDT(ORDT)_U_$$STS(ORIFN)
64 ... S I=0 F S I=$O(ORRCTX(I)) Q:I<1 S ORN=ORN+1,@ORY@(ORN)="Order="_ORRCTX(I)
65 ... I $G(ORDET) D ORD ;add Detailed Display to @ORY@(#)
66 ;S ORY(0)=CNT
67 Q
68 ;
69LIST(ORY,ORPAT,ORTYPE,ORUSR,ORDET,ORBEG,OREND) ; -- Return orders for ORPAT where
70 ; ORTYPE = ORN: Active Nursing Orders (2)
71 ; ORV: Orders Unverified by Nursing (9)
72 ; ORU: Unsigned Orders by ORUSR (11)
73 ; in @ORY@(#) = Item=ID^Text^OrderDate in HL7 format^Status
74 ; = Order=line of order text, & if ORDET
75 ; = Text=line of report text
76 ; where ID = ORTYPE_":"_order#;action#
77 ; RPC = ORRC ORDERS BY PATIENT
78 N ORN,ORWARD,ORIGVIEW,ORFLG,ORID,ORDG,ORLIST,ORI,ORIFN,ORACT,OR0,ORA0,ORDT,ORRCTX,I
79 S ORY=$NA(^TMP($J,"ORRCORD")) K @ORY
80 S ORUSR=+$G(ORUSR),ORPAT=+$G(ORPAT)_";DPT(",ORTYPE=$G(ORTYPE,"ORD")
81 S ORWARD=$G(^DPT(+ORPAT,.1)),ORIGVIEW=1
82 S:$L(ORWARD) ORWARD=+$O(^DIC(42,"B",ORWARD,0))
83 S ORFLG=$S(ORTYPE="ORU":11,ORTYPE="ORV":9,1:2),ORID=ORTYPE_":"
84 S ORDG=$S(ORTYPE="ORN":"NURS",1:"ALL"),ORDG=+$O(^ORD(100.98,"B",ORDG,0))
85 S:$G(ORBEG) ORBEG=$$HL7TFM^XLFDT(ORBEG) S:$G(OREND) OREND=$$HL7TFM^XLFDT(OREND)
86 D EN^ORQ1(ORPAT,ORDG,ORFLG,,$G(ORBEG),$G(OREND)) S (ORI,ORN)=0
87 F S ORI=+$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1 S ORIFN=^(ORI) D
88 . S ORACT=+$P(ORIFN,";",2) S:ORACT<1 ORACT=+$P($G(^OR(100,+ORIFN,3)),U,7)
89 . S OR0=$G(^OR(100,+ORIFN,0)),ORA0=$G(^(8,ORACT,0))
90 . I ORFLG=11,+$P(ORA0,U,3)'=ORUSR Q
91 . S ORDT=$S('$P(OR0,U,8):$P(ORA0,U),"^DC^HD^"[(U_$P(ORA0,U,2)_U):$P(ORA0,U),1:$P(OR0,U,8))
92 . D TEXT^ORQ12(.ORRCTX,ORIFN,200)
93 . S ORN=ORN+1,@ORY@(ORN)="Item="_ORID_ORIFN_U_$$TXT1_U_$$FMTHL7^XLFDT(ORDT)_U_$$STS(ORIFN)
94 . S I=0 F S I=$O(ORRCTX(I)) Q:I<1 S ORN=ORN+1,@ORY@(ORN)="Order="_ORRCTX(I)
95 . I $G(ORDET) D ORD ;add Detailed Display to @ORY@(#)
96 Q
97 ;
98DETAIL(ORY,ORDER) ; -- Return details of ORDERs
99 ; where ORDER(#) = ID
100 ; in @ORY@(#) = Item=ID^Text^OrderDate in HL7 format^Status
101 ; = Order=line of order text
102 ; = Text=line of report text
103 ; RPC = ORRC ORDERS BY ID [and from DETAIL^ORRCSIG]
104 N ORN,ORI,ORID,ORIFN,ORACT,ORDT,ORRCTX,I
105 S ORN=0,ORY=$NA(^TMP($J,"ORRCORD")) K @ORY
106 S ORI="" F S ORI=$O(ORDER(ORI)) Q:ORI="" S ORID=ORDER(ORI) D
107 . S ORIFN=$P(ORID,":",2),ORACT=+$P(ORIFN,";",2)
108 . S:ORACT<1 ORACT=+$P($G(^OR(100,+ORIFN,3)),U,7) S:ORACT<1 ORACT=1
109 . S ORDT=+$G(^OR(100,+ORIFN,8,ORACT,0))
110 . D TEXT^ORQ12(.ORRCTX,ORIFN,200)
111 . S ORN=ORN+1,@ORY@(ORN)="Item="_ORID_U_$$TXT1_U_$P($$FMTHL7^XLFDT(ORDT),"-")_U_$$STS(ORIFN)
112 . S I=0 F S I=$O(ORRCTX(I)) Q:I<1 S ORN=ORN+1,@ORY@(ORN)="Order="_ORRCTX(I)
113 . D ORD
114 Q
115 ;
116TXT(IFN) ; -- Return [first line of] order IFN's text
117 N ORRCTX,Y D TEXT^ORQ12(.ORRCTX,$G(IFN),200)
118 S Y=$G(ORRCTX(1))_$S($O(ORRCTX(1)):"...",1:"")
119 Q Y
120 ;
121TXT1() ; -- Return [first line of] order text from ORRCTX()
122 N Y
123 S Y=$G(ORRCTX(1))_$S($O(ORRCTX(1)):"...",1:"")
124 Q Y
125 ;
126STS(IFN) ; --Return name of order IFN's status
127 N STS,X,Y
128 S STS=+$P($G(^OR(100,+$G(IFN),3)),U,3)
129 S X=$P($G(^ORD(100.01,STS,0)),U),Y=$$LOW^XLFSTR(X)
130 Q Y
131 ;
132ORD ; -- Add details of ORIFN to @ORY@(ORN)
133 Q:'+$G(ORIFN) N ORRCZ,ORI,ORVP
134 S ORVP=$P($G(^OR(100,+ORIFN,0)),U,2)
135 S ORRCZ="^TMP($J,""ORRCTXT"")" D DETAIL^ORQ2(.ORRCZ,ORIFN)
136 S ORI=0 F S ORI=$O(@ORRCZ@(ORI)) Q:ORI<1 S ORN=ORN+1,@ORY@(ORN)="Text="_@ORRCZ@(ORI)
137 K @ORRCZ
138 Q
139 ;
140VERIFY(ORY,ORUSR,ORDER) ; -- Mark ORDERs as verified by ORUSR
141 ;where ORDER(#) = ID = ORV:order#;action#
142 ;returns ORY(#) = ID^1 if successful, else ID^0^error
143 ;RPC = ORRC ORDERS VERIFY
144 Q:'$G(ORUSR) N ORVER,ORI,ORID,ORIFN,ORACT,ORA0,ORLK,ORES,ORERR,ORVP,ORWARD
145 K ORY S ORVER="N"
146 S ORI="" F S ORI=$O(ORDER(ORI)) Q:ORI="" D
147 . S ORID=ORDER(ORI),ORIFN=$P(ORID,":",2),ORACT=+$P(ORIFN,";",2)
148 . I ORACT<1 S ORACT=+$P($G(^OR(100,+ORIFN,3)),U,7),ORIFN=+ORIFN_";"_ORACT
149 . S ORA0=$G(^OR(100,+ORIFN,8,ORACT,0)) I $P(ORA0,U,9) D Q ;verified
150 .. N WHO,WHEN,X S WHO=$P(ORA0,U,8),WHEN=$P(ORA0,U,9),X=""
151 .. S:WHO X=X_" by "_$$UP^XLFSTR($$NAME^XUSER(WHO,"F"))
152 .. S:WHEN X=X_" on "_$$FMTE^XLFDT(WHEN,"2P")
153 .. S ORY(ORI)=ORID_"^0^This order has been verified"_X_"!" Q
154 . S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK S ORY(ORI)=ORID_U_ORLK Q
155 . S ORES(ORIFN)=ORID,ORES("B",ORIFN)=ORI
156 . D REPLCD^ORCACT1 ;incl unverified replaced orders
157 Q:'$O(ORES(0)) S ORIFN=0 F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN<1 D
158 . S ORVP=$P($G(^OR(100,+ORIFN,0)),U,2),ORVP(ORVP)=""
159 . D EN^ORCSEND(ORIFN,"VR","","",,,.ORERR),UNLK1^ORX2(+ORIFN)
160 . S ORID=$G(ORES(ORIFN)),ORI=+$G(ORES("B",ORIFN))
161 . I ORI S ORY(ORI)=ORID_U_$S($G(ORERR):"0^"_$P(ORERR,U,2),1:1)
162 S ORVP="" F S ORVP=$O(ORVP(ORVP)) Q:ORVP="" D
163 . S ORWARD=$S($G(^DPT(+ORVP,.105)):1,1:0) ;inpt
164 . D CKALERT^ORCACT1 ;delete unver orders alerts
165 Q
166 ;
167COMP(ORY,ORUSR,ORDER) ; -- Mark ORDERs as completed by ORUSR
168 ;where ORDER(#) = ID = ORN:order#;action#
169 ;returns ORY(#) = ID^1 if successful, else ID^0^error
170 ;RPC = ORRC ORDERS COMPLETE
171 Q:'$G(ORUSR) N ORNOW,ORI,ORID,ORIFN,ORLK
172 K ORY S ORNOW=+$E($$NOW^XLFDT,1,12)
173 S ORI="" F S ORI=$O(ORDER(ORI)) Q:ORI="" D
174 . S ORID=ORDER(ORI),ORIFN=+$P(ORID,":",2)
175 . S ORLK=$$LOCK1^ORX2(ORIFN) I 'ORLK S ORY(ORI)=ORID_U_ORLK Q
176 . D COMP^ORCSAVE2(ORIFN,ORUSR,ORNOW),UNLK1^ORX2(ORIFN)
177 . S ORY(ORI)=ORID_U_$S($P($G(^OR(100,ORIFN,6)),U,6):1,1:0)
178 Q
Note: See TracBrowser for help on using the repository browser.