source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWPCE1.m@ 613

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

initial load of WorldVistAEHR
File size: 8.4 KB
Line 
1ORWPCE1 ;SLC/KCM - PCE Calls from CPRS GUI; 10/26/04 ;4/9/08 07:44
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,132,148,187,190,215,243**;Dec 17, 1997;Build 242
3 ;
4 ; DBIA 1365 DSELECT^GMPLENFM ^TMP("IB",$J)
5 ;
6GETVSIT(VSTR,DFN) ; lookup a visit
7 N PKG,SRC,ORPXAPI,OK,ORVISIT
8 S PKG=$O(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING",0))
9 S SRC="TEXT INTEGRATION UTILITIES"
10 S ORPXAPI("ENCOUNTER",1,"ENC D/T")=$P(VSTR,";",2)
11 S ORPXAPI("ENCOUNTER",1,"PATIENT")=DFN
12 S ORPXAPI("ENCOUNTER",1,"HOS LOC")=+VSTR
13 S ORPXAPI("ENCOUNTER",1,"SERVICE CATEGORY")=$P(VSTR,";",3)
14 S ORPXAPI("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
15 S OK=$$DATA2PCE^PXAPI("ORPXAPI",PKG,SRC,.ORVISIT)
16 Q ORVISIT
17DQDEL ; background call to DATA2PCE and DELVFILE
18 N VISIT,VAL
19 I $D(ZTQUEUED) S ZTREQ="@"
20 S VISIT=$$GETVSIT(VSTR,DFN)
21 S VAL=$$DELVFILE^PXAPI("ALL",VISIT,"","TEXT INTEGRATION UTILITIES")
22 S ZTSTAT=0 ; clear sync flag
23 Q
24DQSAVE ; Background Call to DATA2PCE
25 N PKG,SRC,TYP,CODE,IEN,OK,I,X,ORPXAPI,ORPXDEL
26 N CAT,NARR,ROOT,ROOT2,ORAVST
27 N PRV,CPT,ICD,IMM,SK,PED,HF,XAM,TRT,MOD,MODCNT,MODIDX,MODS
28 N COM,COMMENT,COMMENTS
29 N DFN,PROBLEMS,PXAPREDT,ORCPTDEL
30 I $D(ZTQUEUED) S ZTREQ="@"
31 S PKG=$O(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING",0))
32 S SRC="TEXT INTEGRATION UTILITIES"
33 S (PRV,CPT,ICD,IMM,SK,PED,HF,XAM,TRT)=0
34 S I="" F S I=$O(PCELIST(I)) Q:'I S X=PCELIST(I) D
35 . S X=PCELIST(I),TYP=$P(X,U),CODE=$P(X,U,2),CAT=$P(X,U,3),NARR=$P(X,U,4)
36 . I $E(TYP,1,3)="PRV" D Q
37 . . Q:'$L(CODE)
38 . . S PRV=PRV+1
39 . . S ROOT="ORPXAPI(""PROVIDER"","_PRV_")"
40 . . S ROOT2="ORPXDEL(""PROVIDER"","_PRV_")"
41 . . I $E(TYP,4)'="-" D
42 . . . S @ROOT@("NAME")=CODE
43 . . . S @ROOT@("PRIMARY")=$P(X,U,6)
44 . . S @ROOT2@("NAME")=CODE
45 . . S @ROOT2@("DELETE")=1
46 . . S PXAPREDT=1 ;Allow edit of primary flag
47 . I TYP="VST" D Q
48 . . S ROOT="ORPXAPI(""ENCOUNTER"",1)"
49 . . I CODE="DT" S @ROOT@("ENC D/T")=$P(X,U,3) Q
50 . . I CODE="PT" S @ROOT@("PATIENT")=$P(X,U,3),DFN=$P(X,U,3) Q
51 . . I CODE="HL" S @ROOT@("HOS LOC")=$P(X,U,3) Q
52 . . I CODE="PR" S @ROOT@("PARENT")=$P(X,U,3) Q
53 . . ;prevents checkout!
54 . . I CODE="VC" S @ROOT@("SERVICE CATEGORY")=$P(X,U,3) Q
55 . . I CODE="SC" S @ROOT@("SC")=$P(X,U,3) Q
56 . . I CODE="AO" S @ROOT@("AO")=$P(X,U,3) Q
57 . . I CODE="IR" S @ROOT@("IR")=$P(X,U,3) Q
58 . . I CODE="EC" S @ROOT@("EC")=$P(X,U,3) Q
59 . . I CODE="MST" S @ROOT@("MST")=$P(X,U,3) Q
60 . . I CODE="HNC" S @ROOT@("HNC")=$P(X,U,3) Q
61 . . I CODE="CV" S @ROOT@("CV")=$P(X,U,3) Q
62 . . I CODE="SHD" S @ROOT@("SHAD")=$P(X,U,3) Q
63 . . I CODE="OL" D Q
64 . . . I +$P(X,U,3) S @ROOT@("INSTITUTION")=$P(X,U,3)
65 . . . E I $P(X,U,4)'="",$P(X,U,4)'="0" D
66 . . . . I $$PATCH^XPDUTL("PX*1.0*96") S @ROOT@("OUTSIDE LOCATION")=$P(X,U,4)
67 . . . . E S @ROOT@("COMMENT")="OUTSIDE LOCATION: "_$P(X,U,4)
68 . I $E(TYP,1,3)="CPT" D Q
69 . . Q:'$L(CODE)
70 . . S CPT=CPT+1,ROOT="ORPXAPI(""PROCEDURE"","_CPT_")"
71 . . S IEN=+$O(^ICPT("B",CODE,0))
72 . . S @ROOT@("PROCEDURE")=IEN
73 . . I +$P(X,U,9) D
74 . . . S MODS=$P(X,U,9),MODCNT=+MODS
75 . . . F MODIDX=1:1:MODCNT D
76 . . . . S MOD=$P($P(MODS,";",MODIDX+1),"/")
77 . . . . S @ROOT@("MODIFIERS",MOD)=""
78 . . S:$L(CAT) @ROOT@("CATEGORY")=CAT
79 . . S:$L(NARR) @ROOT@("NARRATIVE")=NARR
80 . . S:$L($P(X,U,5)) @ROOT@("QTY")=$P(X,U,5)
81 . . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
82 . . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="PROCEDURE^"_CPT
83 . . I $E(TYP,4)="-" S @ROOT@("DELETE")=1,@ROOT@("QTY")=0,ORCPTDEL=CPT
84 . I $E(TYP,1,3)="POV" D Q
85 . . Q:'$L(CODE)
86 . . S ICD=ICD+1,ROOT="ORPXAPI(""DX/PL"","_ICD_")"
87 . . S IEN=+$O(^ICD9("AB",CODE_" ",0))
88 . . S @ROOT@("DIAGNOSIS")=IEN
89 . . S @ROOT@("PRIMARY")=$P(X,U,5)
90 . . S:$L(CAT) @ROOT@("CATEGORY")=CAT
91 . . S:$L(NARR) @ROOT@("NARRATIVE")=NARR
92 . . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
93 . . I $L($P(X,U,7)),$P(X,U,7)=1 S @ROOT@("PL ADD")=$P(X,U,7),PROBLEMS(ICD)=NARR_U_CODE
94 . . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="DX/PL^"_ICD
95 . . I $E(TYP,4)="-" S @ROOT@("DELETE")=1
96 . I $E(TYP,1,3)="IMM" D Q
97 . . Q:'$L(CODE)
98 . . S IMM=IMM+1,ROOT="ORPXAPI(""IMMUNIZATION"","_IMM_")"
99 . . S @ROOT@("IMMUN")=CODE
100 . . S:$L($P(X,U,5)) @ROOT@("SERIES")=$P(X,U,5)
101 . . S:$L($P(X,U,5)) @ROOT@("REACTION")=$P(X,U,7)
102 . . S:$L($P(X,U,8)) @ROOT@("CONTRAINDICATED")=$P(X,U,8)
103 . . S:$L($P(X,U,9)) @ROOT@("REFUSED")=$P(X,U,9)
104 . . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
105 . . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="IMMUNIZATION^"_IMM
106 . . I $E(TYP,4)="-" S @ROOT@("DELETE")=1
107 . I $E(TYP,1,2)="SK" D Q
108 . . Q:'$L(CODE)
109 . . S SK=SK+1,ROOT="ORPXAPI(""SKIN TEST"","_SK_")"
110 . . S @ROOT@("TEST")=CODE
111 . . S:$L($P(X,U,5)) @ROOT@("RESULT")=$P(X,U,5)
112 . . S:$L($P(X,U,7)) @ROOT@("READING")=$P(X,U,7)
113 . . S:$L($P(X,U,8)) @ROOT@("D/T READ")=$P(X,U,8)
114 . . S:$L($P(X,U,9)) @ROOT@("EVENT D/T")=$P(X,U,9)
115 . . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
116 . . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="SKIN TEST^"_SK
117 . . I $E(TYP,3)="-" S @ROOT@("DELETE")=1
118 . I $E(TYP,1,3)="PED" D Q
119 . . Q:'$L(CODE)
120 . . S PED=PED+1,ROOT="ORPXAPI(""PATIENT ED"","_PED_")"
121 . . S @ROOT@("TOPIC")=CODE
122 . . S:$L($P(X,U,5)) @ROOT@("UNDERSTANDING")=$P(X,U,5)
123 . . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
124 . . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="PATIENT ED^"_PED
125 . . I $E(TYP,4)="-" S @ROOT@("DELETE")=1
126 . I $E(TYP,1,2)="HF" D Q
127 . . Q:'$L(CODE)
128 . . S HF=HF+1,ROOT="ORPXAPI(""HEALTH FACTOR"","_HF_")"
129 . . S @ROOT@("HEALTH FACTOR")=CODE
130 . . S:$L($P(X,U,5)) @ROOT@("LEVEL/SEVERITY")=$P(X,U,5)
131 . . S:$P(X,U,6)'>0 $P(X,U,6)=$G(ORPXAPI("PROVIDER",1,"NAME"))
132 . . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
133 . . S:$L($P(X,U,11)) @ROOT@("EVENT D/T")=$P($P(X,U,11),";",1)
134 . . S:$L($P(X,U,11)) SRC=$P($P(X,U,11),";",2)
135 . . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="HEALTH FACTOR^"_HF
136 . . I $E(TYP,3)="-" S @ROOT@("DELETE")=1
137 . I $E(TYP,1,3)="XAM" D Q
138 . . Q:'$L(CODE)
139 . . S XAM=XAM+1,ROOT="ORPXAPI(""EXAM"","_XAM_")"
140 . . S @ROOT@("EXAM")=CODE
141 . . S:$L($P(X,U,5)) @ROOT@("RESULT")=$P(X,U,5)
142 . . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
143 . . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="EXAM^"_XAM
144 . . I $E(TYP,4)="-" S @ROOT@("DELETE")=1
145 . I $E(TYP,1,3)="TRT" D Q
146 . . Q:'$L(CODE)
147 . . S TRT=TRT+1,ROOT="ORPXAPI(""TREATMENT"","_TRT_")"
148 . . S @ROOT@("IMMUN")=CODE
149 . . S:$L(CAT) @ROOT@("CATEGORY")=CAT
150 . . S:$L(NARR) @ROOT@("NARRATIVE")=NARR
151 . . S:$L($P(X,U,5)) @ROOT@("QTY")=$P(X,U,5)
152 . . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
153 . . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="TREATMENT^"_TRT
154 . . I $E(TYP,4)="-" S @ROOT@("DELETE")=1,@ROOT@("QTY")=0
155 . I $E(TYP,1,3)="COM" D Q
156 . . Q:'$L(CODE)
157 . . Q:'$L(CAT)
158 . . S COMMENTS(CODE)=$P(X,U,3,999)
159 ;Store the comments
160 S COM=""
161 F S COM=$O(COMMENT(COM)) Q:COM="" S:$D(COMMENTS(COM)) ORPXAPI($P(COMMENT(COM),"^",1),$P(COMMENT(COM),"^",2),"COMMENT")=COMMENTS(COM)
162 ;
163 ;Remove any problems to add that the patient already has as active problems
164 I $D(PROBLEMS),$D(DFN) D
165 . N ORWPROB,ORPROBIX
166 . K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
167 . D DSELECT^GMPLENFM ;DBIA 1365
168 . S ORPROBIX=0
169 . F S ORPROBIX=$O(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX)) Q:'ORPROBIX D ;DBIA 1365
170 .. S ORWPROB=$P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3)
171 .. S ORWPROB($S($E(ORWPROB,1)="$":$E(ORWPROB,2,255),1:ORWPROB))=""
172 . K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
173 . Q:'$D(ORWPROB)
174 . S ORPROBIX=""
175 . F S ORPROBIX=$O(PROBLEMS(ORPROBIX)) Q:'ORPROBIX D
176 .. S:$D(ORWPROB(PROBLEMS(ORPROBIX))) ORPXAPI("DX/PL",ORPROBIX,"PL ADD")=0
177 ;
178 I $$MDS(.ORPXAPI,$G(ORLOC)) S ORPXAPI("ENCOUNTER",1,"CHECKOUT D/T")=$$NOW^XLFDT
179 S ORPXAPI("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
180DATA2PCE ;
181 I $G(PXAPREDT)!($G(ORCPTDEL)) D
182 . M ORPXDEL("ENCOUNTER")=ORPXAPI("ENCOUNTER")
183 . I $G(ORCPTDEL) M ORPXDEL("PROCEDURE",ORCPTDEL)=ORPXAPI("PROCEDURE",ORCPTDEL)
184 . S OK=$$DATA2PCE^PXAPI("ORPXDEL",PKG,SRC,.ORAVST)
185 S OK=$$DATA2PCE^PXAPI("ORPXAPI",PKG,SRC,.ORAVST)
186 I OK>0,+NOTEIEN,+ORAVST D ; NOTEIEN only set on inpatient encounters
187 .N OROK,ORX
188 .S ORX(1207)=ORAVST
189 .D FILE^TIUSRVP(.OROK,NOTEIEN,.ORX,1)
190 S ZTSTAT=0 ; clear sync flag
191 Q
192 ;
193MDS(X,ORLOC) ; return TRUE if checkout is needed
194 I $$CHKOUT^ORWPCE2(ORLOC) Q 1
195 N I,ORAUTO,OROK
196 S (OROK,I)=0
197 F S I=$O(X("DX/PL",I)) Q:'I D Q:OROK
198 . I $G(X("DX/PL",I,"DIAGNOSIS")) S OROK=1
199 I 'OROK D
200 .S I=0 F S I=$O(X("PROCEDURE",I)) Q:'I D Q:OROK
201 .. I $G(X("PROCEDURE",I,"PROCEDURE")) S OROK=1
202 I $D(X("PROVIDER",1,"NAME")) S OROK=1
203 Q OROK
204NONCOUNT(ORY,ORLOC) ; Is the location a non-count clinic? (DBIA #964)
205 Q:'ORLOC
206 S ORY=$S($P($G(^SC(ORLOC,0)),U,17)="Y":1,1:0)
207 Q
Note: See TracBrowser for help on using the repository browser.