source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUVSIT.m@ 985

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1TIUVSIT ; SLC/JER - Interactive Visit look-up; 28-OCT-2003 [1/27/05 12:35pm]
2 ;;1.0;TEXT INTEGRATION UTILITIES;**39,91,107,117,179,190**;Jun 20, 1997;Build 1
3ENPN(TIUY,DFN,ALLOWNEW) ; Entry point for Progress Notes
4 N DIRUT,DUOUT,DTOUT,TIULOC,TIUINOUT
5 I +$G(DFN)'>0 Q
6 I +$D(^DPT(DFN,.1)) D MAIN^TIUMOVE(.TIUY,DFN,"","","","1","CURRENT",0) Q
7 S TIUINOUT=$$INOUT
8 I $D(DIRUT) Q
9 I $P(TIUINOUT,U)="o" D MAIN(.TIUY,DFN,"","","","",1,"","",$G(ALLOWNEW)) Q
10 D MAIN^TIUMOVE(.TIUY,DFN,"","","",1,"LAST",1)
11 Q
12MAIN(TIUY,DFN,TIUSSN,TIUVDT,TIULDT,TIUDFLT,TIUMODE,TIULOC,TIUOCC,LETNEW) ;Control
13 N TIUFUTUR
14AGN K ^TMP("TIUVN",$J),^TMP("TIUVDT",$J),^TMP("TIUVNI",$J),^TMP("TIUNOT",$J),^TMP($J,"SDAMA301")
15 N C,I,N,TIUI,TIUII,TIUDA,TIUER,TIUOK,TIUX,TIUOUT,X,TIUNVIS,VASD,VAERR
16 N TIUPICK,TIULAST,TIUSDC,TIUVTRY,TIUAPPTS,TIUARR
17 S TIUMODE=$G(TIUMODE,1),LETNEW=$G(LETNEW,1)
18 S:+$G(DFN)'>0 DFN=+$$PATIENT^TIULA($G(TIUSSN)) I +DFN'>0 S TIUOUT=1 Q
19 S TIUOCC=$G(TIUOCC,20)
20 S TIUARR("FLDS")="1;2"
21 S TIUARR(1)=2000000,TIUARR(4)=DFN,TIUARR("MAX")=1
22 S TIUAPPTS=$$SDAPI^SDAMA301(.TIUARR)
23 K ^TMP($J,"SDAMA301")
24 I TIUAPPTS=-1 D Q
25 . W !!,"Could not retrieve patient information due to a problem with the database.",!,"Please contact IRM"
26 I '$G(TIUAPPTS),(+TIUMODE'>0) Q
27 ; No appointments
28 I '$G(TIUAPPTS),(+TIUMODE>0) D I +$G(TIUX)'>0 Q
29 . W !!,"No SCHEDULED APPOINTMENTS on file"
30 . D MAIN^TIUVISIT(.TIUY,DFN,$G(TIUSSN),$G(TIUVDT),$G(TIULDT),$G(TIUDFLT),$G(TIUMODE),$G(TIULOC),$G(TIUOCC),$G(LETNEW),"H",1,.TIUFUTUR)
31 . I +$G(TIUOUT) Q
32 . I '$D(TIUY),+LETNEW,'+$G(TIUVTRY) D ADD(DFN,.TIUX,1,.TIUSDC)
33 I '$G(TIUAPPTS),(+TIUX>0) G VADPT
34 I '$D(^TMP("TIUVN",$J)) D GETAPPT^TIUVSIT1(DFN,$G(TIULOC),$G(TIUOCC),$G(TIULDT),"",.TIULAST,$G(TIUVDT),+$G(TIUFUTUR)) S TIUFUTUR=0
35 ; error in visit lookup
36 I +TIUMODE,$D(^TMP("TIUVERR",$J)) D Q
37 . W !!,$G(^TMP("TIUVERR",$J)),!
38 . I $D(^TMP("TIUVERR",$J,115)) W ^TMP("TIUVERR",$J,115),!
39 . K ^TMP("TIUVERR",$J)
40 ; no appointments scheduled w/in selection range
41 I +TIUMODE,'$D(^TMP("TIUVN",$J)),+LETNEW D G:+$G(TIUFUTUR) AGN Q:+$G(TIUX)'>0 G VADPT
42 . N WHATNOW
43 . W !!,"No SCHEDULED APPOINTMENTS found through "
44 . W $$DATE^TIULS($$FMADD^XLFDT(DT,1),"AMTH DD, CCYY"),"...",!
45 . S WHATNOW=$$UP^XLFSTR($E($$NOTFOUND^TIUVSIT1))
46 . Q:$S(+$G(DUOUT):1,+$G(DTOUT):1,+$G(DIROUT):1,1:0)
47 . I $E(WHATNOW)="U" D Q
48 . . D MAIN^TIUVISIT(.TIUY,DFN,$G(TIUSSN),$G(TIUVDT),$G(TIULDT),$G(TIUDFLT),$G(TIUMODE),$G(TIULOC),$G(TIUOCC),$G(LETNEW),"H",1,.TIUFUTUR) Q:+$G(TIUFUTUR)
49 . . I '$D(TIUY),+LETNEW,'+$G(TIUVTRY) D ADD(DFN,.TIUX,1,.TIUSDC)
50 . I $E(WHATNOW)="F" S TIUFUTUR=1 Q ; FUTURE
51 . D ADD(DFN,.TIUX,$S($E(WHATNOW)="N":"",1:1),.TIUSDC)
52 I '+TIUMODE,'$D(^TMP("TIUVNI",$J)) Q
53 I '+TIUMODE,$G(TIUDFLT)="LAST" D Q:+$G(TIUX)'>0 G VADPT
54 . N TIUI S TIUI=+$O(^TMP("TIUVNI",$J,0))
55 . S TIUX=$$GETVSIT(TIUI)
56 I +TIUMODE,($G(TIUDFLT)="LAST"),(+$O(^TMP("TIUVNI",$J,0))>0) S TIUPICK=+$O(^TMP("TIUVNI",$J,0))
57 S (TIUER,TIUOK,TIUI)=0
58 W !!,"The following SCHEDULED VISITS are available:",!
59 F S TIUI=$O(^TMP("TIUVN",$J,TIUI)) Q:+TIUI'>0 D Q:+TIUER!+TIUOK!+$G(TIUX)!+$G(TIUOUT)
60 . S TIUII=TIUI D WRITE
61 . I '(TIUI#5) D BREAK I $S($G(X)="U":1,$G(X)["UNS":1,1:0) D Q
62 . . D MAIN^TIUVISIT(.TIUY,DFN,$G(TIUSSN),$G(TIUVDT),$G(TIULDT),$G(TIUDFLT),$G(TIUMODE),$G(TIULOC),$G(TIUOCC),$G(LETNEW),"H",1,.TIUFUTUR)
63 . . S TIUOUT=1
64 . I $G(X)["?" S X="",TIUI=TIUI-5
65 . I $G(X)["F" S X=""
66 I +$G(TIUFUTUR),$S(+TIUOK:1,+TIUER:1,$D(TIUY)>9:1,+$G(TIUX):1,1:0) S TIUFUTUR=0
67 I +$G(TIUFUTUR) S TIUOUT=0 G AGN
68 G:$D(TIUOUT) CLEAN
69 G AGN:+TIUER
70 I +$G(TIUII)#5,+TIUMODE D BREAK I $S($G(X)="U":1,$G(X)["UNS":1,1:0) D G:+$G(TIUFUTUR) AGN Q
71 . D MAIN^TIUVISIT(.TIUY,DFN,$G(TIUSSN),$G(TIUVDT),$G(TIULDT),$G(TIUDFLT),$G(TIUMODE),$G(TIULOC),$G(TIUOCC),$G(LETNEW),"H",1,.TIUFUTUR)
72 G:$D(TIUOUT) CLEAN
73 I $S(+TIUER:1,$G(X)["?":1,$G(X)["F":1,1:0) G AGN
74 I +TIUOK,'+$G(TIUNVIS) D
75 . S TIUX=$$GETVSIT(+TIUOK)
76 . W " ",$$DATE^TIULS(+$P(TIUX,";",2),"AMTH DD CCYY@HR:MIN")
77VADPT D PATVADPT^TIULV(.TIUY,DFN,"",$G(TIUX),$G(TIUSDC))
78CLEAN K ^TMP("TIUVN",$J),^TMP("TIUVDT",$J),^TMP("TIUVNI",$J),^TMP("TIUNOT",$J)
79 Q
80BREAK ; Handle prompting
81 I TIUII=1 S (TIUOK,X)=1
82 W !,"CHOOSE 1-",TIUII,", or",!
83 W:'(TIUII#20) "<M>ORE VISITS, " W "<U>NSCHEDULED VISITS, "
84 I +$P(TIUPRM0,U,14) W:'+LETNEW " or " W "<F>UTURE VISITS, "
85 W:+LETNEW "or <N>EW VISIT"
86 W:$D(^TMP("TIUVN",$J,TIUII+1)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT"
87 W ": " W:$D(TIUPICK) $P(^TMP("TIUVN",$J,TIUPICK),U),"// " R X:DTIME
88 S X=$$UP^XLFSTR(X)
89 I $S('$T:1,X["^":1,1:0) S (TIUER,TIUOUT)=1 Q
90 S:X=""&$D(TIUPICK) X=TIUPICK
91 I X["?" D HELP^TIUVSITH(X) Q
92 I $S(X="M":1,X="MORE":1,1:0) D MORE Q
93 I $S(X="F":1,X["FUT":1,1:0) D FUTURE Q
94 I $S(X="U":1,X["UNS":1,1:0) Q
95 I +LETNEW'>0,(X=""),'$D(^TMP("TIUVN",$J,TIUII+1)) S (TIUER,TIUOUT)=1 Q
96 I +LETNEW,$S(X="N":1,X="NEW":1,X=""&'$D(^TMP("TIUVN",$J,TIUII+1)):1,1:0) D ADD(DFN,.TIUX,$S(X="N":0,X="NEW":0,1:1),.TIUSDC) I +$G(TIUX)'>0 S (TIUER,TIUOUT)=1 Q
97 I $S(X="":1,X="N":1,X="NEW":1,1:0) Q
98 I X'=+X!'$D(^TMP("TIUVN",$J,+X)) W !!,$C(7),"INVALID RESPONSE",! G BREAK
99 S TIUOK=X
100 Q
101INOUT() ; Ask INPATIENT/OUTPATIENT
102 N TIUPRMT S TIUPRMT="Is this note for INPATIENT or OUTPATIENT care? "
103 W:'$D(^DPT(DFN,.1)) !!,"This patient is not currently admitted to the facility...",!
104 Q $$READ^TIUU("SA^i:INPATIENT;o:OUTPATIENT",TIUPRMT,"OUTPATIENT")
105MORE ; Modify date range, list more visits
106 N TIUI,TIUCNT
107 S TIUI=+$O(^TMP("TIUVDT",$J,0)),TIUCNT=+$G(^TMP("TIUVDT",$J,+TIUI))
108 D GETAPPT^TIUVSIT1(DFN,$G(TIULOC),$G(TIUOCC),TIUI,TIUCNT,.TIULAST)
109 Q
110FUTURE ; Get future appointments
111 D GETAPPT^TIUVSIT1(DFN,$G(TIULOC),$G(TIUOCC),$G(TIULDT),"",.TIULAST,$G(TIUVDT),1)
112 I $D(^TMP("TIUVERR",$J)) D
113 . W !!,$G(^TMP("TIUVERR",$J)),!
114 . I $D(^TMP("TIUVERR",$J,115)) W ^TMP("TIUVERR",$J,115),!
115 I $P(+$G(^TMP("TIUVNI",$J,1)),".")'>+$$NOW^XLFDT D
116 . W !!,"No Future Appointments found...",!
117 E I $P(+$G(^TMP("TIUVNI",$J,1)),".")'>$$FMADD^XLFDT(DT,1) D
118 . W !!,"No Appointments found more than one day in future..."
119 S TIUI=0,TIUFUTUR=1
120 Q
121GETVSIT(TIUOK) ; Get associated visit
122 N APPT,TIUVSIT,VLOC,VSTOP,VDT,VTYPE
123 S APPT=$G(^TMP("TIUVNI",$J,+TIUOK))
124 S VDT=+APPT,VLOC=$P(APPT,U,2)
125 S VSTOP=$P($G(^SC(+VLOC,0)),U,7)
126 S VTYPE=$S($P(APPT,U,3)="I":"I",1:"A")
127 S TIUVSIT=VLOC_";"_VDT_";"_VTYPE
128 Q TIUVSIT
129ADD(DFN,VSTR,ASK,VSTOP) ; Add a visit for patient
130 N VTYPE,VDT,VLOC,TIUY,DA,DIE,DR,TIUAPDT,X,Y W !
131 S ASK=$G(ASK,1)
132 I +ASK D
133 . W !,$C(7),$C(7),"Patient & Visit are Required...",!
134 . S TIUY=$$READ^TIUU("YAO","Do you wish to add a NEW Visit? ","NO")
135 I +ASK,(+TIUY'>0) S TIUX=0,TIUER=1 Q
136 I $G(VLOC)']"" S VLOC=$$SELLOC
137 I +VLOC'>0 S TIUER=1 Q
138 S VSTOP=+$P(^SC(+VLOC,0),U,7)
139 S VDT=+$$READ^TIUU("D^:NOW:ERSX","Enter Visit Date/Time","NOW","Precise Date & Time are Required")
140 I +VDT'>0 S TIUER=1 Q
141 S TIUAPDT=+$O(^TMP("TIUNOT",$J,+VLOC,+$P(VDT,".")))
142 I +TIUAPDT>0,(+$P(TIUAPDT,".")=+$P(VDT,".")) D Q
143 . W !!,$C(7)," Item #",+$G(^TMP("TIUNOT",$J,+VLOC,+TIUAPDT))
144 . W " is scheduled for ",$$DATE^TIULS(TIUAPDT,"MM/DD/YY HR:MIN")
145 . W " at this location..."
146 . W !!,"Please select the existing appointment, rather than creating a "
147 . W "redundant one.",!
148 . S TIUER=1
149 S VTYPE=$$VSITYPE(VSTOP)
150 S VSTR=+VLOC_";"_+VDT_";"_VTYPE
151 I +VSTR'>0 S TIUER=1 Q
152 S TIUNVIS=+VDT,TIUER=0
153 Q
154WRITE ; Writes each list element
155 N TIUX S TIUX=^TMP("TIUVN",$J,TIUI)
156 W !,$J(TIUII,4),"> ",$P(TIUX,U),?27,$E($P(TIUX,U,3),1,21),?50,$P(TIUX,U,2)
157 Q
158SELLOC() ; Select Hospital Location
159 N DIC,X,Y,TIUAPDT S DIC=44,DIC(0)="AEMQ"
160 S DIC("A")="PATIENT LOCATION: "
161 S DIC("B")=$P($$PERSLOC^TIULE(DUZ),U,2)
162 S:DIC("B")']"" DIC("B")=$P($G(^SC(+$G(^DISV(DUZ,"^SC(")),0)),U)
163 S DIC("S")="I $$GOODLOC^TIUPREF(Y)"
164 D ^DIC K DIC("S")
165 Q Y
166DEFER(DA,TIUSDC) ; Mark record for deferred crediting of stop code
167 N DIE,DR,X,Y,TIUVSIT
168 I +$G(TIUSDC)'>0 Q
169 S DIE=8925
170 S:$$WORKOK^TIUPXAP1(+DA) DR=".11////1;"
171 S DR=$G(DR)_"1206////^S X="_+TIUSDC
172 D ^DIE
173 ;If not called via the broker try to link document to an existing visit
174 I '$$BROKER^XWBLIB,$$LNKVST^TIUPXAP3(+DA,.TIUVSIT)
175 Q
176CREDIT(TIUDA) ; Call EN3^SDACS to Credit Stop Code
177 N DA,DFN,VSIT,TIU,TIUD0,TIUDPRM
178 S TIUD0=$G(^TIU(8925,+TIUDA,0))
179 I TIUD0']"" Q
180 D DOCPRM^TIULC1(+TIUD0,.TIUDPRM)
181 ; If SUPPRESS DX/CPT ON NEW VISIT is set to YES, then Quit
182 I +$P($G(TIUDPRM(0)),U,14)>0 Q
183 S DFN=+$P(TIUD0,U,2),VSIT=$P(TIUD0,U,3)
184 D GETTIU^TIULD(.TIU,TIUDA)
185 D CREDIT^TIUPXAPI(DFN,.TIU,VSIT)
186 Q
187REMFLAG(DA) ; Remove credit flag from TIU Document Record
188 N DIE,DR,X,Y
189 S DIE=8925,DR=".11///@" D ^DIE
190 Q
191VSITYPE(VSTOP) ; Call reader to get VISIT TYPE
192 N DFLT,PROMPT,X,Y S VSTOP=$P($G(^DIC(40.7,+$G(VSTOP),0)),U)
193 S DFLT=$S(VSTOP["TELE":"TELEPHONE",1:"AMBULATORY")
194 S PROMPT="TYPE OF VISIT: "
195 S X="SMA^a:AMBULATORY (WALK-IN);t:TELEPHONE;i:IN HOSPITAL;e:EVENT (HISTORICAL)"
196 S Y=$$READ^TIUU(X,PROMPT,DFLT) W " ",$P(Y,U,2),!
197 S Y=$$UP^XLFSTR($P(Y,U))
198 Q Y
199GETAPPT(DFN,CLINIC,OCCLIM,INDEX,COUNT,LAST,EARLY,FUTURE) ; Get list
200 D GETAPPT^TIUVSIT1($G(DFN),$G(CLINIC),$G(OCCLIM),$G(INDEX),$G(COUNT),$G(LAST),$G(EARLY),$G(FUTURE))
201 Q
Note: See TracBrowser for help on using the repository browser.