source: FOIAVistA/tag/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPXAP2.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1TIUPXAP2 ; SLC/JER - More code for the workload capture ;12/4/02@07:54:52 [1/18/05 9:27am]
2 ;;1.0;TEXT INTEGRATION UTILITIES;**20,67,82,107,126,124,149,179,190**;Jun 20, 1997;Build 1
3TEST ; Test the PXAPI Data Capture dialogs
4 N CPT,DFN,ICD,ICDARR,CPTARR,SC,DTOUT,TIU,TIUOK
5 S DFN=+$$PATIENT^TIULA
6 S TIU("LOC")=$$SELLOC^TIUVSIT
7 D GETICD^TIUPXAPI(TIU("LOC"),.ICDARR)
8 D ICD^TIUPXAPI(.ICD,.ICDARR)
9 D GETCPT^TIUPXAPC(TIU("LOC"),.CPTARR)
10CPTCALL D CPT^TIUPXAPC(.CPT,.CPTARR)
11 I '$D(CPT),'$D(DTOUT) W !!,$C(7),"You MUST enter one or more Procedures." G CPTCALL
12 D SCASK^TIUPXAPS(.SC,+DFN,.TIU)
13 I $D(DTOUT)!(+$O(ICD(0))'>0)&(+$O(CPT(0))'>0)&(+$O(SC(0))'>0) D Q
14 . W !,$C(7),"Insufficient information for Workload Credit."
15 . W !,"Missing information will have to be captured by another method."
16 S TIUOK=$$CONFIRM^TIUPXAPI(.ICD,.CPT,.SC)
17 I '+TIUOK D G TEST
18 . W !!,"Changes Discarded. Please Enter Corrected Workload Data..." H 3
19 . K ICD,CPT,SC,ICDARR,CPTARR
20 K CPTARR,ICDARR
21 W "Done."
22 Q
23CMBLST(EMCODES,CPTCODES) ; Combine E/M and other CPT codes
24 N TIUI,TIUJ,TMPARRY S (TIUI,TIUJ)=0
25 M TMPARRY=EMCODES S TIUI=EMCODES(0)
26 F S TIUJ=$O(CPTCODES(TIUJ)) Q:+TIUJ'>0 D
27 . S TIUI=+$G(TIUI)+1,TMPARRY(TIUI)=CPTCODES(TIUJ),TMPARRY(0)=TIUI
28 . ;Merge CPT Modifiers
29 . M TMPARRY(TIUI,"MODIFIER")=CPTCODES(TIUJ,"MODIFIER")
30 K CPTCODES
31 M CPTCODES=TMPARRY
32 Q
33PICK(LOW,HIGH,PROMPT,TYPE) ; List selection
34 N X,Y S PROMPT=$G(PROMPT,"Select Item"),TYPE=$G(TYPE,"LO")
35 W !
36 S Y=$$READ^TIUU(TYPE_U_LOW_":"_HIGH,PROMPT)
37 Q Y
38EDTENC(TIUDA,CHNG) ; Edit the encounter for a given note
39 N TIUD0,TIUD12,TIUDFN,TIUI,TIUVSIT,TIUHL,TIUEDT,TIUPAUSE,TIUERR,TIUWHAT
40 N TIUCONT,DA
41 Q:$D(XWBOS)
42 Q:+$P($G(TIUDPRM(0)),U,14)
43 D FULL^VALM1
44 S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^(12))
45 S TIUHL=$P(TIUD12,U,11)
46 I $P($G(^SC(+TIUHL,0)),U,3)'="C" Q
47 ;
48 ;If not ok to ask workload, quit
49 I '$$WORKOK^TIUPXAP1(+TIUDA) Q
50 ;
51 S TIUDFN=$P(TIUD0,U,2),TIUEDT=$P(TIUD0,U,7),TIUVSIT=$P(TIUD0,U,3)
52 N TIUMVSTF,TIUVSITS
53 ;If no visit has been filed with the document
54 I $G(TIUVSIT)'>0 D
55 . ;Check for the visit
56 . S TIUVSITS=$$GETENC^PXAPI(TIUDFN,TIUEDT,TIUHL)
57 . I TIUVSITS>0 S TIUVSIT=+TIUVSITS
58 . ;Set a flag if multiple visits
59 . I $P(TIUVSITS,U,2)'="" S TIUMVSTF=1
60 . ;If only one visit update the document
61 . I $G(TIUVSIT)>0,'$G(TIUMVSTF) D
62 . . S TIUERR=$$UPDVST(TIUDA,TIUVSIT)
63 . . K ^TMP("PXKENC",$J)
64 W !!
65 ;Ask the user if they wish to enter workload if the parameter is defined
66 ;and the multiple visit flag is not set
67 I $D(TIUDPRM(0)),'$G(TIUMVSTF),$G(TIUVSIT)>0 D Q:'+TIUCONT
68 . S TIUCONT=$$READ^TIUU("Y","Do you wish to enter workload data at this time","YES")
69 I $G(VALMAR)="^TMP(""TIUR"",$J)" D
70 . N TIU D GETTIU^TIULD(.TIU,TIUDA)
71 . W !!,"For ",$G(TIU("PNM"))," ",$G(TIU("PID"))," Visit on "
72 . W $P($G(TIU("EDT")),U,2),"...",!
73 I $P($P(TIUD0,U,7),".")>DT D Q
74 . W !!,$C(7),"ACRP will not accept data for future Encounters.",!
75 . W !,"Workload questions won't be asked for this note.",!
76 . S TIUPAUSE=$$READ^TIUU("EA","Press RETURN to continue...")
77 I $G(VALMAR)'="^TMP(""TIUR"",$J)" W !!,"Editing Encounter Data...",!
78 S TIUWHAT=$S($$CHKAPPT(TIUVSIT,TIUDFN,TIUEDT,TIUHL):"INTV",1:"ADDEDIT")
79 S TIUERR=$$INTV^PXAPI(TIUWHAT,"TIU","TEXT INTEGRATION UTILITIES",.TIUVSIT,$S(+$G(TIUVSIT):"",1:TIUHL),TIUDFN,$S(+$G(TIUVSIT):"",1:TIUEDT))
80 ;
81 ;If an error is returned prompt to continue otherwise if a Visit
82 ;IEN is returned and one is not already defined update the document
83 I +TIUERR<0 D
84 . W ! S TIUPAUSE=$$READ^TIUU("EA","Press RETURN to continue...")
85 ELSE D
86 . I $G(TIUVSIT)>0,'$P($G(^TIU(8925,+TIUDA,0)),U,3) S TIUERR=$$UPDVST(TIUDA,TIUVSIT)
87 S CHNG=1
88 Q
89 ;
90CHKVST(TIUDA) ;Check the visit associated with the document for key workload
91 ;data elements. Key data elements include provider, diagnosis,
92 ;procedure and classifications.
93 ; Input -- TIUDA TIU Document file (#8925) IEN
94 ; Output -- 0=No Key Workload Data Elements Exist
95 ; 1=Key Workload Data Elements Exist
96 ; 2=Unable to Determine if Key Workload Data Elements Exist
97 N I,TIUCHKF,TIUD0,TIUDFN,TIUEDT,TIUHL,TIUVSIT,TIUVSITS,X
98 ;
99 ;Set variables, if the 0th node of the document is not defined quit
100 S TIUD0=$G(^TIU(8925,+TIUDA,0)) I TIUD0="" S TIUCHKF=2 G CHKVSTQ
101 S TIUDFN=$P(TIUD0,U,2),TIUVSIT=$P(TIUD0,U,3),TIUEDT=$P(TIUD0,U,7)
102 S TIUHL=$P($G(^TIU(8925,+TIUDA,12)),U,11)
103 ;
104 ;Get data associated with the visit
105 I $G(TIUVSIT)>0 D
106 . D ENCEVENT^PXKENC(TIUVSIT)
107 ELSE D
108 . S TIUVSITS=$$GETENC^PXAPI(TIUDFN,TIUEDT,TIUHL)
109 . I TIUVSITS>0 S TIUVSIT=+TIUVSITS
110 . I $P(TIUVSITS,U,2)'="" S TIUCHKF=2 ;multiple visits
111 ;
112 ;If a visit is not defined or multiple visits exist, quit
113 I $G(TIUVSIT)'>0!($G(TIUCHKF)=2) G CHKVSTQ
114 ;
115 ;If a provider or diagnosis or procedure exists for the visit, set flag
116 ;and quit
117 I $D(^TMP("PXKENC",$J,TIUVSIT,"PRV"))!($D(^("CPT")))!($D(^("POV"))) S TIUCHKF=1 G CHKVSTQ
118 ;
119 ;If a classification exists for the visit, set flag and quit
120 I $D(^TMP("PXKENC",$J,TIUVSIT,"VST",TIUVSIT,800)) S X=^(800) D
121 . F I=1:1:6 I $P(X,U,I)'="" S TIUCHKF=1 Q
122 ;
123CHKVSTQ K ^TMP("PXKENC",$J)
124 Q +$G(TIUCHKF)
125 ;
126UPDVST(TIUDA,TIUVSIT,ERROR) ;Update Visit in TIU Document file #8925
127 ; Input -- TIUDA TIU Document file (#8925) IEN
128 ; TIUVSIT Visit file (#9000010) IEN
129 ; Output -- 1=Successful and 0=Failure
130 ; ERROR Error Message (Optional)
131 N DIERR,OKF,TIUFDA
132 ;
133 ;Quit if a visit is not defined
134 G UPDVSTQ:$G(TIUVSIT)'>0
135 ;
136 ;Update document with visit
137 S TIUFDA(8925,TIUDA_",",.03)=TIUVSIT
138 L +^TIU(8925,TIUDA):1 I $T D
139 . D FILE^DIE("","TIUFDA","") L -^TIU(8925,TIUDA)
140 . S ERROR=$G(DIERR)
141 . S OKF=$S(+$G(ERROR):0,1:1)
142 ELSE D
143 . S OKF=0
144UPDVSTQ Q +$G(OKF)
145 ;
146CHKWKL(TIUDA,TIUDPRM) ;Check if workload data should be entered
147 ; Input -- TIUDA TIU Document file (#8925) IEN
148 ; TIUDPRM TIU Document Parameters file (#8925.95) Array
149 ; Output -- 1=Enter Workload and 0=Do Not Enter Workload
150 N STATUS,TIUAPPTF,TIUD0,TIUDFN,TIUEDT,TIUHL,TIUVSIT,TIUWKLF,TIURES,TIUINC,TIUARRAY,TIUCNT
151 ;
152 ;Set variables, if the 0th node of the document is not defined quit
153 S TIUD0=$G(^TIU(8925,+TIUDA,0)) G CHKWKLQ:TIUD0=""
154 S TIUDFN=$P(TIUD0,U,2),TIUVSIT=$P(TIUD0,U,3),TIUEDT=$P(TIUD0,U,7)
155 S TIUHL=$P($G(^TIU(8925,+TIUDA,12)),U,11)
156 ;
157 ;Check if an appointment is associated with the visit
158 S:$$CHKAPPT(TIUVSIT,TIUDFN,TIUEDT,TIUHL)>0 TIUAPPTF=1
159 ;
160 ;If an appointment is not associated with the visit, assume
161 ;the visit is new, set flag to enter workload and quit
162 I '$G(TIUAPPTF) S TIUWKLF=1 G CHKWKLQ
163 ;
164 ;Check the parameter 'Ask Dx/CPT on All Opt Visits'. If it is set to
165 ;No, workload should not be entered for the appointment.
166 I '$$BROKER^XWBLIB(),'$P($G(TIUDPRM(0)),U,16) G CHKWKLQ
167 ;
168 ;Get the status of the appointment
169 S TIUARRAY(1)=TIUEDT_";"_TIUEDT
170 S TIUARRAY(2)=TIUHL
171 S TIUARRAY(4)=TIUDFN
172 S TIUARRAY("SORT")="P"
173 S TIUARRAY("FLDS")="22"
174 S TIUARRAY("MAX")=1
175 S TIUCNT=$$SDAPI^SDAMA301(.TIUARRAY)
176 I TIUCNT=-1 K ^TMP($J,"SDAMA301") Q +$G(TIUWKLF)
177 S STATUS=+$P($G(^TMP($J,"SDAMA301",TIUDFN,TIUEDT)),U,22)
178 K ^TMP($J,"SDAMA301")
179 ;Check the status of the appointment. If the appointment can be
180 ;checked-out, workload can be entered.
181 I $D(^SD(409.63,"ACO",1,STATUS)) S TIUWKLF=1
182 ;
183CHKWKLQ Q +$G(TIUWKLF)
184 ;
185CHKAPPT(TIUVSIT,TIUDFN,TIUEDT,TIUHL) ;Check if an appointment is associated with the Visit
186 ; Input -- TIUVSIT Visit file (#9000010) IEN
187 ; TIUDFN Patient file (#2) IEN
188 ; TIUEDT Episode Begin Date/Time
189 ; TIUHL Hospital Location file (#44) IEN
190 ; Output -- 0=Appointment is not associated with the Visit
191 ; 1=Appointment is associated with the Visit
192 N TIUAPPTF
193 I $G(TIUVSIT),'$$BROKER^XWBLIB() D
194 . S:$$VST2APPT^PXAPI(TIUVSIT)>0 TIUAPPTF=1
195 ELSE D
196 . S:$$APPOINT^PXUTL1(TIUDFN,TIUEDT,TIUHL)>0 TIUAPPTF=1
197 Q +$G(TIUAPPTF)
Note: See TracBrowser for help on using the repository browser.