TIUVSIT ; SLC/JER - Interactive Visit look-up;09-Apr-2014 16:23;DU
;;1.0;TEXT INTEGRATION UTILITIES;**39,91,107,117,179,1007,1010,190,1011,1012**;Jun 20, 1997;Build 45
;IHS/ITSC/LJF 02/27/2003 added IHS calls
;IHS/MSC/MGH 02/25/2010 Added mods back after patch 179
;IHS/MSC/MGH Patch 10 added parameter to MAIN entry point
ENPN(TIUY,DFN,ALLOWNEW) ; Entry point for Progress Notes
N DIRUT,DUOUT,DTOUT,TIULOC,TIUINOUT
I +$G(DFN)'>0 Q
D MAIN(.TIUY,DFN,"","","","",1,"","",$G(ALLOWNEW)) Q ;IHS/ITSC/LJF Display all visits
I +$D(^DPT(DFN,.1)) D MAIN^TIUMOVE(.TIUY,DFN,"","","","1","CURRENT",0) Q
S TIUINOUT=$$INOUT
I $D(DIRUT) Q
I $P(TIUINOUT,U)="o" D MAIN(.TIUY,DFN,"","","","",1,"","",$G(ALLOWNEW)) Q
D MAIN^TIUMOVE(.TIUY,DFN,"","","",1,"LAST",1)
Q
MAIN(TIUY,DFN,TIUSSN,TIUVDT,TIULDT,TIUDFLT,TIUMODE,TIULOC,TIUOCC,LETNEW,TIUCAT) ;Control
N TIUFUTUR
S TIUCAT=$G(TIUCAT)
AGN K ^TMP("TIUVN",$J),^TMP("TIUVDT",$J),^TMP("TIUVNI",$J),^TMP("TIUNOT",$J),^TMP($J,"SDAMA301")
N C,I,N,TIUI,TIUII,TIUDA,TIUER,TIUOK,TIUX,TIUOUT,X,TIUNVIS,VASD,VAERR
N TIUPICK,TIULAST,TIUSDC,TIUVTRY,TIUAPPTS,TIUARR
S TIUMODE=$G(TIUMODE,1),LETNEW=$G(LETNEW,1)
S:+$G(DFN)'>0 DFN=+$$PATIENT^TIULA($G(TIUSSN)) I +DFN'>0 S TIUOUT=1 Q
S TIUOCC=$G(TIUOCC,20)
;
K BTIUQ D FINDVST^BTIUVSIT Q:$G(BTIUQ) K BTIUQ G IHS1 ;IHS/ITSC/LJF
;
S TIUARR("FLDS")="1;2"
S TIUARR(1)=2000000,TIUARR(4)=DFN,TIUARR("MAX")=1
S TIUAPPTS=$$SDAPI^SDAMA301(.TIUARR)
K ^TMP($J,"SDAMA301")
I TIUAPPTS=-1 D Q
. W !!,"Could not retrieve patient information due to a problem with the database.",!,"Please contact IRM"
I '$G(TIUAPPTS),(+TIUMODE'>0) Q
; No appointments
I '$G(TIUAPPTS),(+TIUMODE>0) D I +$G(TIUX)'>0 Q
. W !!,"No SCHEDULED APPOINTMENTS on file"
. D MAIN^TIUVISIT(.TIUY,DFN,$G(TIUSSN),$G(TIUVDT),$G(TIULDT),$G(TIUDFLT),$G(TIUMODE),$G(TIULOC),$G(TIUOCC),$G(LETNEW),"H",1,.TIUFUTUR)
. I +$G(TIUOUT) Q
. I '$D(TIUY),+LETNEW,'+$G(TIUVTRY) D ADD(DFN,.TIUX,1,.TIUSDC)
I '$G(TIUAPPTS),(+TIUX>0) G VADPT
I '$D(^TMP("TIUVN",$J)) D GETAPPT^TIUVSIT1(DFN,$G(TIULOC),$G(TIUOCC),$G(TIULDT),"",.TIULAST,$G(TIUVDT),+$G(TIUFUTUR)) S TIUFUTUR=0
; error in visit lookup
I +TIUMODE,$D(^TMP("TIUVERR",$J)) D Q
. W !!,$G(^TMP("TIUVERR",$J)),!
. I $D(^TMP("TIUVERR",$J,115)) W ^TMP("TIUVERR",$J,115),!
. K ^TMP("TIUVERR",$J)
; no appointments scheduled w/in selection range
I +TIUMODE,'$D(^TMP("TIUVN",$J)),+LETNEW D G:+$G(TIUFUTUR) AGN Q:+$G(TIUX)'>0 G VADPT
. N WHATNOW
. W !!,"No SCHEDULED APPOINTMENTS found through "
. W $$DATE^TIULS($$FMADD^XLFDT(DT,1),"AMTH DD, CCYY"),"...",!
. S WHATNOW=$$UP^XLFSTR($E($$NOTFOUND^TIUVSIT1))
. Q:$S(+$G(DUOUT):1,+$G(DTOUT):1,+$G(DIROUT):1,1:0)
. I $E(WHATNOW)="U" D Q
. . 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)
. . I '$D(TIUY),+LETNEW,'+$G(TIUVTRY) D ADD(DFN,.TIUX,1,.TIUSDC)
. I $E(WHATNOW)="F" S TIUFUTUR=1 Q ; FUTURE
. D ADD(DFN,.TIUX,$S($E(WHATNOW)="N":"",1:1),.TIUSDC)
I '+TIUMODE,'$D(^TMP("TIUVNI",$J)) Q
;
IHS1 ;IHS/ITSC/LJF 02/27/2003 Added line label
;
I '+TIUMODE,$G(TIUDFLT)="LAST" D Q:+$G(TIUX)'>0 G VADPT
. N TIUI S TIUI=+$O(^TMP("TIUVNI",$J,0))
. S TIUX=$$GETVSIT(TIUI)
I +TIUMODE,($G(TIUDFLT)="LAST"),(+$O(^TMP("TIUVNI",$J,0))>0) S TIUPICK=+$O(^TMP("TIUVNI",$J,0))
S (TIUER,TIUOK,TIUI)=0
;W !!,"The following SCHEDULED VISITS are available:",! ;IHS/ITSC/LJF
W !!,"The following VISITS are available:",! ;IHS/ITSC/LJF
F S TIUI=$O(^TMP("TIUVN",$J,TIUI)) Q:+TIUI'>0 D Q:+TIUER!+TIUOK!+$G(TIUX)!+$G(TIUOUT)
. S TIUII=TIUI D WRITE
. I '(TIUI#5) D BREAK I $S($G(X)="U":1,$G(X)["UNS":1,1:0) D Q
. . D MAIN^TIUVISIT(.TIUY,DFN,$G(TIUSSN),$G(TIUVDT),$G(TIULDT),$G(TIUDFLT),$G(TIUMODE),$G(TIULOC),$G(TIUOCC),$G(LETNEW),"H",1,.TIUFUTUR)
. . S TIUOUT=1
. I $G(X)["?" S X="",TIUI=TIUI-5
. I $G(X)["F" S X=""
I +$G(TIUFUTUR),$S(+TIUOK:1,+TIUER:1,$D(TIUY)>9:1,+$G(TIUX):1,1:0) S TIUFUTUR=0
I +$G(TIUFUTUR) S TIUOUT=0 G AGN
G:$D(TIUOUT) CLEAN
G AGN:+TIUER
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
. D MAIN^TIUVISIT(.TIUY,DFN,$G(TIUSSN),$G(TIUVDT),$G(TIULDT),$G(TIUDFLT),$G(TIUMODE),$G(TIULOC),$G(TIUOCC),$G(LETNEW),"H",1,.TIUFUTUR)
G:$D(TIUOUT) CLEAN
I $S(+TIUER:1,$G(X)["?":1,$G(X)["F":1,1:0) G AGN
I +TIUOK,'+$G(TIUNVIS) D
. S TIUX=$$GETVSIT(+TIUOK)
. W " ",$$DATE^TIULS(+$P(TIUX,";",2),"AMTH DD CCYY@HR:MIN")
VADPT D PATVADPT^TIULV(.TIUY,DFN,"",$G(TIUX),$G(TIUSDC))
CLEAN K ^TMP("TIUVN",$J),^TMP("TIUVDT",$J),^TMP("TIUVNI",$J),^TMP("TIUNOT",$J)
Q
BREAK ; Handle prompting
I TIUII=1 S (TIUOK,X)=1
W !,"CHOOSE 1-",TIUII,", or",!
;
;;IHS/ITSC/LJF 05/08/2003 add choice to view visit
;W:'(TIUII#20) "<M>ORE VISITS, " W "<U>NSCHEDULED VISITS, "
W:'(TIUII#20) "<M>ORE VISITS, " W "<V>IEW VISITS, "
;I +$P(TIUPRM0,U,14) W:'+LETNEW " or " W "<F>UTURE VISITS, "
W:+LETNEW "or <N>EW VISIT"
;W:$D(^TMP("TIUVN",$J,TIUII+1)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT"
W:$D(^TMP("TIUVN",$J,TIUII+1)) !,"<RETURN> TO CONTINUE or '^' TO QUIT "
;W ": " W:$D(TIUPICK) $P(^TMP("TIUVN",$J,TIUPICK),U),"// " R X:DTIME
R X:DTIME
;IHS/ITSC/LJF 05/08/2003 end of mods
;
S X=$$UP^XLFSTR(X)
I $S('$T:1,X["^":1,1:0) S (TIUER,TIUOUT)=1 Q
S:X=""&$D(TIUPICK) X=TIUPICK
I X?1"V".N D VV^BTIUPCC(X) S TIUI=0 D BREAK Q ;IHS/ITSC/LJF 05/08/2003
I X["?" D HELP^TIUVSITH(X) Q
I $S(X="M":1,X="MORE":1,1:0) D MORE Q
;I $S(X="F":1,X["FUT":1,1:0) D FUTURE Q ;IHS/ITSC/LJF 05/08/2003
;I $S(X="U":1,X["UNS":1,1:0) Q ;IHS/ITSC/LJF 05/08/2003
I +LETNEW'>0,(X=""),'$D(^TMP("TIUVN",$J,TIUII+1)) S (TIUER,TIUOUT)=1 Q
;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 ;IHS/ITSC/LJF 02/27/2003
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(TIUER) S TIUOUT=1 Q ;IHS/ITSC/LJF 02/27/2003 change quit logic
I $S(X="":1,X="N":1,X="NEW":1,1:0) Q
I X'=+X!'$D(^TMP("TIUVN",$J,+X)) W !!,$C(7),"INVALID RESPONSE",! G BREAK
S TIUOK=X
Q
INOUT() ; Ask INPATIENT/OUTPATIENT
N TIUPRMT S TIUPRMT="Is this note for INPATIENT or OUTPATIENT care? "
W:'$D(^DPT(DFN,.1)) !!,"This patient is not currently admitted to the facility...",!
Q $$READ^TIUU("SA^i:INPATIENT;o:OUTPATIENT",TIUPRMT,"OUTPATIENT")
MORE ; Modify date range, list more visits
N TIUI,TIUCNT
S TIUI=+$O(^TMP("TIUVDT",$J,0)),TIUCNT=+$G(^TMP("TIUVDT",$J,+TIUI))
D GETAPPT^TIUVSIT1(DFN,$G(TIULOC),$G(TIUOCC),TIUI,TIUCNT,.TIULAST)
Q
FUTURE ; Get future appointments
D GETAPPT^TIUVSIT1(DFN,$G(TIULOC),$G(TIUOCC),$G(TIULDT),"",.TIULAST,$G(TIUVDT),1)
I $D(^TMP("TIUVERR",$J)) D
. W !!,$G(^TMP("TIUVERR",$J)),!
. I $D(^TMP("TIUVERR",$J,115)) W ^TMP("TIUVERR",$J,115),!
I $P(+$G(^TMP("TIUVNI",$J,1)),".")'>+$$NOW^XLFDT D
. W !!,"No Future Appointments found...",!
E I $P(+$G(^TMP("TIUVNI",$J,1)),".")'>$$FMADD^XLFDT(DT,1) D
. W !!,"No Appointments found more than one day in future..."
S TIUI=0,TIUFUTUR=1
Q
GETVSIT(TIUOK) ; Get associated visit
S BTIUVSIT=$G(^TMP("TIUIHSV",$J,TIUOK)) ;IHS/ITSC/LJF 02/27/2003 set IHS visit variable
N APPT,TIUVSIT,VLOC,VSTOP,VDT,VTYPE
S APPT=$G(^TMP("TIUVNI",$J,+TIUOK))
S VDT=+APPT,VLOC=$P(APPT,U,2)
S VSTOP=$P($G(^SC(+VLOC,0)),U,7)
;S VTYPE=$S($P(APPT,U,3)="I":"I",1:"A") ;IHS/ITSC/LJF 02/27/2003
S VTYPE=$P(APPT,U,3) ;IHS/ITSC/LJF 02/27/2003
S TIUVSIT=VLOC_";"_VDT_";"_VTYPE
Q TIUVSIT
ADD(DFN,VSTR,ASK,VSTOP) ; Add a visit for patient
N VTYPE,VDT,VLOC,TIUY,DA,DIE,DR,TIUAPDT,X,Y W !
S ASK=$G(ASK,1)
I +ASK D
. W !,$C(7),$C(7),"Patient & Visit are Required...",!
. S TIUY=$$READ^TIUU("YAO","Do you wish to add a NEW Visit? ","NO")
I +ASK,(+TIUY'>0) S TIUX=0,TIUER=1 Q
;
D ADD^BTIUVSIT($G(DFN),"",$G(TIUSDC)) Q ;IHS/ITSC/LJF 02/27/2003 use IHS code to add visit, then quit
;
I $G(VLOC)']"" S VLOC=$$SELLOC
I +VLOC'>0 S TIUER=1 Q
S VSTOP=+$P(^SC(+VLOC,0),U,7)
S VDT=+$$READ^TIUU("D^:NOW:ERSX","Enter Visit Date/Time","NOW","Precise Date & Time are Required")
I +VDT'>0 S TIUER=1 Q
S TIUAPDT=+$O(^TMP("TIUNOT",$J,+VLOC,+$P(VDT,".")))
I +TIUAPDT>0,(+$P(TIUAPDT,".")=+$P(VDT,".")) D Q
. W !!,$C(7)," Item #",+$G(^TMP("TIUNOT",$J,+VLOC,+TIUAPDT))
. W " is scheduled for ",$$DATE^TIULS(TIUAPDT,"MM/DD/YY HR:MIN")
. W " at this location..."
. W !!,"Please select the existing appointment, rather than creating a "
. W "redundant one.",!
. S TIUER=1
S VTYPE=$$VSITYPE(VSTOP)
S VSTR=+VLOC_";"_+VDT_";"_VTYPE
I +VSTR'>0 S TIUER=1 Q
S TIUNVIS=+VDT,TIUER=0
Q
WRITE ; Writes each list element
N TIUX S TIUX=^TMP("TIUVN",$J,TIUI)
W !,$J(TIUII,4),"> ",$P(TIUX,U),?27,$E($P(TIUX,U,3),1,21),?50,$P(TIUX,U,2)
Q
SELLOC() ; Select Hospital Location
N DIC,X,Y,TIUAPDT S DIC=44,DIC(0)="AEMQ"
S DIC("A")="PATIENT LOCATION: "
S DIC("B")=$P($$PERSLOC^TIULE(DUZ),U,2)
S:DIC("B")']"" DIC("B")=$P($G(^SC(+$G(^DISV(DUZ,"^SC(")),0)),U)
S DIC("S")="I $$GOODLOC^TIUPREF(Y)"
D ^DIC K DIC("S")
Q Y
DEFER(DA,TIUSDC) ; Mark record for deferred crediting of stop code
N DIE,DR,X,Y,TIUVSIT
I +$G(TIUSDC)'>0 Q
S DIE=8925
S:$$WORKOK^TIUPXAP1(+DA) DR=".11////1;"
S DR=$G(DR)_"1206////^S X="_+TIUSDC
D ^DIE
;If not called via the broker try to link document to an existing visit
I '$$BROKER^XWBLIB,$$LNKVST^TIUPXAP3(+DA,.TIUVSIT)
Q
CREDIT(TIUDA) ; Call EN3^SDACS to Credit Stop Code
N DA,DFN,VSIT,TIU,TIUD0,TIUDPRM
S TIUD0=$G(^TIU(8925,+TIUDA,0))
I TIUD0']"" Q
D DOCPRM^TIULC1(+TIUD0,.TIUDPRM)
; If SUPPRESS DX/CPT ON NEW VISIT is set to YES, then Quit
I +$P($G(TIUDPRM(0)),U,14)>0 Q
S DFN=+$P(TIUD0,U,2),VSIT=$P(TIUD0,U,3)
D GETTIU^TIULD(.TIU,TIUDA)
D CREDIT^TIUPXAPI(DFN,.TIU,VSIT)
Q
REMFLAG(DA) ; Remove credit flag from TIU Document Record
N DIE,DR,X,Y
S DIE=8925,DR=".11///@" D ^DIE
Q
VSITYPE(VSTOP) ; Call reader to get VISIT TYPE
N DFLT,PROMPT,X,Y S VSTOP=$P($G(^DIC(40.7,+$G(VSTOP),0)),U)
S DFLT=$S(VSTOP["TELE":"TELEPHONE",1:"AMBULATORY")
S PROMPT="TYPE OF VISIT: "
S X="SMA^a:AMBULATORY (WALK-IN);t:TELEPHONE;i:IN HOSPITAL;e:EVENT (HISTORICAL)"
S Y=$$READ^TIUU(X,PROMPT,DFLT) W " ",$P(Y,U,2),!
S Y=$$UP^XLFSTR($P(Y,U))
Q Y
GETAPPT(DFN,CLINIC,OCCLIM,INDEX,COUNT,LAST,EARLY,FUTURE) ; Get list
D GETAPPT^TIUVSIT1($G(DFN),$G(CLINIC),$G(OCCLIM),$G(INDEX),$G(COUNT),$G(LAST),$G(EARLY),$G(FUTURE))
Q
TIUVSIT ; SLC/JER - Interactive Visit look-up;09-Apr-2014 16:23;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**39,91,107,117,179,1007,1010,190,1011,1012**;Jun 20, 1997;Build 45
+2 ;IHS/ITSC/LJF 02/27/2003 added IHS calls
+3 ;IHS/MSC/MGH 02/25/2010 Added mods back after patch 179
+4 ;IHS/MSC/MGH Patch 10 added parameter to MAIN entry point
ENPN(TIUY,DFN,ALLOWNEW) ; Entry point for Progress Notes
+1 NEW DIRUT,DUOUT,DTOUT,TIULOC,TIUINOUT
+2 IF +$GET(DFN)'>0
QUIT
+3 ;IHS/ITSC/LJF Display all visits
DO MAIN(.TIUY,DFN,"","","","",1,"","",$GET(ALLOWNEW))
QUIT
+4 IF +$DATA(^DPT(DFN,.1))
DO MAIN^TIUMOVE(.TIUY,DFN,"","","","1","CURRENT",0)
QUIT
+5 SET TIUINOUT=$$INOUT
+6 IF $DATA(DIRUT)
QUIT
+7 IF $PIECE(TIUINOUT,U)="o"
DO MAIN(.TIUY,DFN,"","","","",1,"","",$GET(ALLOWNEW))
QUIT
+8 DO MAIN^TIUMOVE(.TIUY,DFN,"","","",1,"LAST",1)
+9 QUIT
MAIN(TIUY,DFN,TIUSSN,TIUVDT,TIULDT,TIUDFLT,TIUMODE,TIULOC,TIUOCC,LETNEW,TIUCAT) ;Control
+1 NEW TIUFUTUR
+2 SET TIUCAT=$GET(TIUCAT)
AGN KILL ^TMP("TIUVN",$JOB),^TMP("TIUVDT",$JOB),^TMP("TIUVNI",$JOB),^TMP("TIUNOT",$JOB),^TMP($JOB,"SDAMA301")
+1 NEW C,I,N,TIUI,TIUII,TIUDA,TIUER,TIUOK,TIUX,TIUOUT,X,TIUNVIS,VASD,VAERR
+2 NEW TIUPICK,TIULAST,TIUSDC,TIUVTRY,TIUAPPTS,TIUARR
+3 SET TIUMODE=$GET(TIUMODE,1)
SET LETNEW=$GET(LETNEW,1)
+4 IF +$GET(DFN)'>0
SET DFN=+$$PATIENT^TIULA($GET(TIUSSN))
IF +DFN'>0
SET TIUOUT=1
QUIT
+5 SET TIUOCC=$GET(TIUOCC,20)
+6 ;
+7 ;IHS/ITSC/LJF
KILL BTIUQ
DO FINDVST^BTIUVSIT
IF $GET(BTIUQ)
QUIT
KILL BTIUQ
GOTO IHS1
+8 ;
+9 SET TIUARR("FLDS")="1;2"
+10 SET TIUARR(1)=2000000
SET TIUARR(4)=DFN
SET TIUARR("MAX")=1
+11 SET TIUAPPTS=$$SDAPI^SDAMA301(.TIUARR)
+12 KILL ^TMP($JOB,"SDAMA301")
+13 IF TIUAPPTS=-1
Begin DoDot:1
+14 WRITE !!,"Could not retrieve patient information due to a problem with the database.",!,"Please contact IRM"
End DoDot:1
QUIT
+15 IF '$GET(TIUAPPTS)
IF (+TIUMODE'>0)
QUIT
+16 ; No appointments
+17 IF '$GET(TIUAPPTS)
IF (+TIUMODE>0)
Begin DoDot:1
+18 WRITE !!,"No SCHEDULED APPOINTMENTS on file"
+19 DO MAIN^TIUVISIT(.TIUY,DFN,$GET(TIUSSN),$GET(TIUVDT),$GET(TIULDT),$GET(TIUDFLT),$GET(TIUMODE),$GET(TIULOC),$GET(TIUOCC),$GET(LETNEW),"H",1,.TIUFUTUR)
+20 IF +$GET(TIUOUT)
QUIT
+21 IF '$DATA(TIUY)
IF +LETNEW
IF '+$GET(TIUVTRY)
DO ADD(DFN,.TIUX,1,.TIUSDC)
End DoDot:1
IF +$GET(TIUX)'>0
QUIT
+22 IF '$GET(TIUAPPTS)
IF (+TIUX>0)
GOTO VADPT
+23 IF '$DATA(^TMP("TIUVN",$JOB))
DO GETAPPT^TIUVSIT1(DFN,$GET(TIULOC),$GET(TIUOCC),$GET(TIULDT),"",.TIULAST,$GET(TIUVDT),+$GET(TIUFUTUR))
SET TIUFUTUR=0
+24 ; error in visit lookup
+25 IF +TIUMODE
IF $DATA(^TMP("TIUVERR",$JOB))
Begin DoDot:1
+26 WRITE !!,$GET(^TMP("TIUVERR",$JOB)),!
+27 IF $DATA(^TMP("TIUVERR",$JOB,115))
WRITE ^TMP("TIUVERR",$JOB,115),!
+28 KILL ^TMP("TIUVERR",$JOB)
End DoDot:1
QUIT
+29 ; no appointments scheduled w/in selection range
+30 IF +TIUMODE
IF '$DATA(^TMP("TIUVN",$JOB))
IF +LETNEW
Begin DoDot:1
+31 NEW WHATNOW
+32 WRITE !!,"No SCHEDULED APPOINTMENTS found through "
+33 WRITE $$DATE^TIULS($$FMADD^XLFDT(DT,1),"AMTH DD, CCYY"),"...",!
+34 SET WHATNOW=$$UP^XLFSTR($EXTRACT($$NOTFOUND^TIUVSIT1))
+35 IF $SELECT(+$GET(DUOUT)
QUIT
+36 IF $EXTRACT(WHATNOW)="U"
Begin DoDot:2
+37 DO MAIN^TIUVISIT(.TIUY,DFN,$GET(TIUSSN),$GET(TIUVDT),$GET(TIULDT),$GET(TIUDFLT),$GET(TIUMODE),$GET(TIULOC),$GET(TIUOCC),$GET(LETNEW),"H",1,.TIUFUTUR)
IF +$GET(TIUFUTUR)
QUIT
+38 IF '$DATA(TIUY)
IF +LETNEW
IF '+$GET(TIUVTRY)
DO ADD(DFN,.TIUX,1,.TIUSDC)
End DoDot:2
QUIT
+39 ; FUTURE
IF $EXTRACT(WHATNOW)="F"
SET TIUFUTUR=1
QUIT
+40 DO ADD(DFN,.TIUX,$SELECT($EXTRACT(WHATNOW)="N":"",1:1),.TIUSDC)
End DoDot:1
IF +$GET(TIUFUTUR)
GOTO AGN
IF +$GET(TIUX)'>0
QUIT
GOTO VADPT
+41 IF '+TIUMODE
IF '$DATA(^TMP("TIUVNI",$JOB))
QUIT
+42 ;
IHS1 ;IHS/ITSC/LJF 02/27/2003 Added line label
+1 ;
+2 IF '+TIUMODE
IF $GET(TIUDFLT)="LAST"
Begin DoDot:1
+3 NEW TIUI
SET TIUI=+$ORDER(^TMP("TIUVNI",$JOB,0))
+4 SET TIUX=$$GETVSIT(TIUI)
End DoDot:1
IF +$GET(TIUX)'>0
QUIT
GOTO VADPT
+5 IF +TIUMODE
IF ($GET(TIUDFLT)="LAST")
IF (+$ORDER(^TMP("TIUVNI",$JOB,0))>0)
SET TIUPICK=+$ORDER(^TMP("TIUVNI",$JOB,0))
+6 SET (TIUER,TIUOK,TIUI)=0
+7 ;W !!,"The following SCHEDULED VISITS are available:",! ;IHS/ITSC/LJF
+8 ;IHS/ITSC/LJF
WRITE !!,"The following VISITS are available:",!
+9 FOR
SET TIUI=$ORDER(^TMP("TIUVN",$JOB,TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+10 SET TIUII=TIUI
DO WRITE
+11 IF '(TIUI#5)
DO BREAK
IF $SELECT($GET(X)="U":1,$GET(X)["UNS":1,1:0)
Begin DoDot:2
+12 DO MAIN^TIUVISIT(.TIUY,DFN,$GET(TIUSSN),$GET(TIUVDT),$GET(TIULDT),$GET(TIUDFLT),$GET(TIUMODE),$GET(TIULOC),$GET(TIUOCC),$GET(LETNEW),"H",1,.TIUFUTUR)
+13 SET TIUOUT=1
End DoDot:2
QUIT
+14 IF $GET(X)["?"
SET X=""
SET TIUI=TIUI-5
+15 IF $GET(X)["F"
SET X=""
End DoDot:1
IF +TIUER!+TIUOK!+$GET(TIUX)!+$GET(TIUOUT)
QUIT
+16 IF +$GET(TIUFUTUR)
IF $SELECT(+TIUOK:1,+TIUER:1,$DATA(TIUY)>9:1,+$GET(TIUX):1,1:0)
SET TIUFUTUR=0
+17 IF +$GET(TIUFUTUR)
SET TIUOUT=0
GOTO AGN
+18 IF $DATA(TIUOUT)
GOTO CLEAN
+19 IF +TIUER
GOTO AGN
+20 IF +$GET(TIUII)#5
IF +TIUMODE
DO BREAK
IF $SELECT($GET(X)="U":1,$GET(X)["UNS":1,1:0)
Begin DoDot:1
+21 DO MAIN^TIUVISIT(.TIUY,DFN,$GET(TIUSSN),$GET(TIUVDT),$GET(TIULDT),$GET(TIUDFLT),$GET(TIUMODE),$GET(TIULOC),$GET(TIUOCC),$GET(LETNEW),"H",1,.TIUFUTUR)
End DoDot:1
IF +$GET(TIUFUTUR)
GOTO AGN
QUIT
+22 IF $DATA(TIUOUT)
GOTO CLEAN
+23 IF $SELECT(+TIUER:1,$GET(X)["?":1,$GET(X)["F":1,1:0)
GOTO AGN
+24 IF +TIUOK
IF '+$GET(TIUNVIS)
Begin DoDot:1
+25 SET TIUX=$$GETVSIT(+TIUOK)
+26 WRITE " ",$$DATE^TIULS(+$PIECE(TIUX,";",2),"AMTH DD CCYY@HR:MIN")
End DoDot:1
VADPT DO PATVADPT^TIULV(.TIUY,DFN,"",$GET(TIUX),$GET(TIUSDC))
CLEAN KILL ^TMP("TIUVN",$JOB),^TMP("TIUVDT",$JOB),^TMP("TIUVNI",$JOB),^TMP("TIUNOT",$JOB)
+1 QUIT
BREAK ; Handle prompting
+1 IF TIUII=1
SET (TIUOK,X)=1
+2 WRITE !,"CHOOSE 1-",TIUII,", or",!
+3 ;
+4 ;;IHS/ITSC/LJF 05/08/2003 add choice to view visit
+5 ;W:'(TIUII#20) "<M>ORE VISITS, " W "<U>NSCHEDULED VISITS, "
+6 IF '(TIUII#20)
WRITE "<M>ORE VISITS, "
WRITE "<V>IEW VISITS, "
+7 ;I +$P(TIUPRM0,U,14) W:'+LETNEW " or " W "<F>UTURE VISITS, "
+8 IF +LETNEW
WRITE "or <N>EW VISIT"
+9 ;W:$D(^TMP("TIUVN",$J,TIUII+1)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT"
+10 IF $DATA(^TMP("TIUVN",$JOB,TIUII+1))
WRITE !,"<RETURN> TO CONTINUE or '^' TO QUIT "
+11 ;W ": " W:$D(TIUPICK) $P(^TMP("TIUVN",$J,TIUPICK),U),"// " R X:DTIME
+12 READ X:DTIME
+13 ;IHS/ITSC/LJF 05/08/2003 end of mods
+14 ;
+15 SET X=$$UP^XLFSTR(X)
+16 IF $SELECT('$TEST:1,X["^":1,1:0)
SET (TIUER,TIUOUT)=1
QUIT
+17 IF X=""&$DATA(TIUPICK)
SET X=TIUPICK
+18 ;IHS/ITSC/LJF 05/08/2003
IF X?1"V".N
DO VV^BTIUPCC(X)
SET TIUI=0
DO BREAK
QUIT
+19 IF X["?"
DO HELP^TIUVSITH(X)
QUIT
+20 IF $SELECT(X="M":1,X="MORE":1,1:0)
DO MORE
QUIT
+21 ;I $S(X="F":1,X["FUT":1,1:0) D FUTURE Q ;IHS/ITSC/LJF 05/08/2003
+22 ;I $S(X="U":1,X["UNS":1,1:0) Q ;IHS/ITSC/LJF 05/08/2003
+23 IF +LETNEW'>0
IF (X="")
IF '$DATA(^TMP("TIUVN",$JOB,TIUII+1))
SET (TIUER,TIUOUT)=1
QUIT
+24 ;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 ;IHS/ITSC/LJF 02/27/2003
+25 ;IHS/ITSC/LJF 02/27/2003 change quit logic
IF +LETNEW
IF $SELECT(X="N":1,X="NEW":1,X=""&'$DATA(^TMP("TIUVN",$JOB,TIUII+1)):1,1:0)
DO ADD(DFN,.TIUX,$SELECT(X="N":0,X="NEW":0,1:1),.TIUSDC)
IF +$GET(TIUER)
SET TIUOUT=1
QUIT
+26 IF $SELECT(X="":1,X="N":1,X="NEW":1,1:0)
QUIT
+27 IF X'=+X!'$DATA(^TMP("TIUVN",$JOB,+X))
WRITE !!,$CHAR(7),"INVALID RESPONSE",!
GOTO BREAK
+28 SET TIUOK=X
+29 QUIT
INOUT() ; Ask INPATIENT/OUTPATIENT
+1 NEW TIUPRMT
SET TIUPRMT="Is this note for INPATIENT or OUTPATIENT care? "
+2 IF '$DATA(^DPT(DFN,.1))
WRITE !!,"This patient is not currently admitted to the facility...",!
+3 QUIT $$READ^TIUU("SA^i:INPATIENT;o:OUTPATIENT",TIUPRMT,"OUTPATIENT")
MORE ; Modify date range, list more visits
+1 NEW TIUI,TIUCNT
+2 SET TIUI=+$ORDER(^TMP("TIUVDT",$JOB,0))
SET TIUCNT=+$GET(^TMP("TIUVDT",$JOB,+TIUI))
+3 DO GETAPPT^TIUVSIT1(DFN,$GET(TIULOC),$GET(TIUOCC),TIUI,TIUCNT,.TIULAST)
+4 QUIT
FUTURE ; Get future appointments
+1 DO GETAPPT^TIUVSIT1(DFN,$GET(TIULOC),$GET(TIUOCC),$GET(TIULDT),"",.TIULAST,$GET(TIUVDT),1)
+2 IF $DATA(^TMP("TIUVERR",$JOB))
Begin DoDot:1
+3 WRITE !!,$GET(^TMP("TIUVERR",$JOB)),!
+4 IF $DATA(^TMP("TIUVERR",$JOB,115))
WRITE ^TMP("TIUVERR",$JOB,115),!
End DoDot:1
+5 IF $PIECE(+$GET(^TMP("TIUVNI",$JOB,1)),".")'>+$$NOW^XLFDT
Begin DoDot:1
+6 WRITE !!,"No Future Appointments found...",!
End DoDot:1
+7 IF '$TEST
IF $PIECE(+$GET(^TMP("TIUVNI",$JOB,1)),".")'>$$FMADD^XLFDT(DT,1)
Begin DoDot:1
+8 WRITE !!,"No Appointments found more than one day in future..."
End DoDot:1
+9 SET TIUI=0
SET TIUFUTUR=1
+10 QUIT
GETVSIT(TIUOK) ; Get associated visit
+1 ;IHS/ITSC/LJF 02/27/2003 set IHS visit variable
SET BTIUVSIT=$GET(^TMP("TIUIHSV",$JOB,TIUOK))
+2 NEW APPT,TIUVSIT,VLOC,VSTOP,VDT,VTYPE
+3 SET APPT=$GET(^TMP("TIUVNI",$JOB,+TIUOK))
+4 SET VDT=+APPT
SET VLOC=$PIECE(APPT,U,2)
+5 SET VSTOP=$PIECE($GET(^SC(+VLOC,0)),U,7)
+6 ;S VTYPE=$S($P(APPT,U,3)="I":"I",1:"A") ;IHS/ITSC/LJF 02/27/2003
+7 ;IHS/ITSC/LJF 02/27/2003
SET VTYPE=$PIECE(APPT,U,3)
+8 SET TIUVSIT=VLOC_";"_VDT_";"_VTYPE
+9 QUIT TIUVSIT
ADD(DFN,VSTR,ASK,VSTOP) ; Add a visit for patient
+1 NEW VTYPE,VDT,VLOC,TIUY,DA,DIE,DR,TIUAPDT,X,Y
WRITE !
+2 SET ASK=$GET(ASK,1)
+3 IF +ASK
Begin DoDot:1
+4 WRITE !,$CHAR(7),$CHAR(7),"Patient & Visit are Required...",!
+5 SET TIUY=$$READ^TIUU("YAO","Do you wish to add a NEW Visit? ","NO")
End DoDot:1
+6 IF +ASK
IF (+TIUY'>0)
SET TIUX=0
SET TIUER=1
QUIT
+7 ;
+8 ;IHS/ITSC/LJF 02/27/2003 use IHS code to add visit, then quit
DO ADD^BTIUVSIT($GET(DFN),"",$GET(TIUSDC))
QUIT
+9 ;
+10 IF $GET(VLOC)']""
SET VLOC=$$SELLOC
+11 IF +VLOC'>0
SET TIUER=1
QUIT
+12 SET VSTOP=+$PIECE(^SC(+VLOC,0),U,7)
+13 SET VDT=+$$READ^TIUU("D^:NOW:ERSX","Enter Visit Date/Time","NOW","Precise Date & Time are Required")
+14 IF +VDT'>0
SET TIUER=1
QUIT
+15 SET TIUAPDT=+$ORDER(^TMP("TIUNOT",$JOB,+VLOC,+$PIECE(VDT,".")))
+16 IF +TIUAPDT>0
IF (+$PIECE(TIUAPDT,".")=+$PIECE(VDT,"."))
Begin DoDot:1
+17 WRITE !!,$CHAR(7)," Item #",+$GET(^TMP("TIUNOT",$JOB,+VLOC,+TIUAPDT))
+18 WRITE " is scheduled for ",$$DATE^TIULS(TIUAPDT,"MM/DD/YY HR:MIN")
+19 WRITE " at this location..."
+20 WRITE !!,"Please select the existing appointment, rather than creating a "
+21 WRITE "redundant one.",!
+22 SET TIUER=1
End DoDot:1
QUIT
+23 SET VTYPE=$$VSITYPE(VSTOP)
+24 SET VSTR=+VLOC_";"_+VDT_";"_VTYPE
+25 IF +VSTR'>0
SET TIUER=1
QUIT
+26 SET TIUNVIS=+VDT
SET TIUER=0
+27 QUIT
WRITE ; Writes each list element
+1 NEW TIUX
SET TIUX=^TMP("TIUVN",$JOB,TIUI)
+2 WRITE !,$JUSTIFY(TIUII,4),"> ",$PIECE(TIUX,U),?27,$EXTRACT($PIECE(TIUX,U,3),1,21),?50,$PIECE(TIUX,U,2)
+3 QUIT
SELLOC() ; Select Hospital Location
+1 NEW DIC,X,Y,TIUAPDT
SET DIC=44
SET DIC(0)="AEMQ"
+2 SET DIC("A")="PATIENT LOCATION: "
+3 SET DIC("B")=$PIECE($$PERSLOC^TIULE(DUZ),U,2)
+4 IF DIC("B")']""
SET DIC("B")=$PIECE($GET(^SC(+$GET(^DISV(DUZ,"^SC(")),0)),U)
+5 SET DIC("S")="I $$GOODLOC^TIUPREF(Y)"
+6 DO ^DIC
KILL DIC("S")
+7 QUIT Y
DEFER(DA,TIUSDC) ; Mark record for deferred crediting of stop code
+1 NEW DIE,DR,X,Y,TIUVSIT
+2 IF +$GET(TIUSDC)'>0
QUIT
+3 SET DIE=8925
+4 IF $$WORKOK^TIUPXAP1(+DA)
SET DR=".11////1;"
+5 SET DR=$GET(DR)_"1206////^S X="_+TIUSDC
+6 DO ^DIE
+7 ;If not called via the broker try to link document to an existing visit
+8 IF '$$BROKER^XWBLIB
IF $$LNKVST^TIUPXAP3(+DA,.TIUVSIT)
+9 QUIT
CREDIT(TIUDA) ; Call EN3^SDACS to Credit Stop Code
+1 NEW DA,DFN,VSIT,TIU,TIUD0,TIUDPRM
+2 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
+3 IF TIUD0']""
QUIT
+4 DO DOCPRM^TIULC1(+TIUD0,.TIUDPRM)
+5 ; If SUPPRESS DX/CPT ON NEW VISIT is set to YES, then Quit
+6 IF +$PIECE($GET(TIUDPRM(0)),U,14)>0
QUIT
+7 SET DFN=+$PIECE(TIUD0,U,2)
SET VSIT=$PIECE(TIUD0,U,3)
+8 DO GETTIU^TIULD(.TIU,TIUDA)
+9 DO CREDIT^TIUPXAPI(DFN,.TIU,VSIT)
+10 QUIT
REMFLAG(DA) ; Remove credit flag from TIU Document Record
+1 NEW DIE,DR,X,Y
+2 SET DIE=8925
SET DR=".11///@"
DO ^DIE
+3 QUIT
VSITYPE(VSTOP) ; Call reader to get VISIT TYPE
+1 NEW DFLT,PROMPT,X,Y
SET VSTOP=$PIECE($GET(^DIC(40.7,+$GET(VSTOP),0)),U)
+2 SET DFLT=$SELECT(VSTOP["TELE":"TELEPHONE",1:"AMBULATORY")
+3 SET PROMPT="TYPE OF VISIT: "
+4 SET X="SMA^a:AMBULATORY (WALK-IN);t:TELEPHONE;i:IN HOSPITAL;e:EVENT (HISTORICAL)"
+5 SET Y=$$READ^TIUU(X,PROMPT,DFLT)
WRITE " ",$PIECE(Y,U,2),!
+6 SET Y=$$UP^XLFSTR($PIECE(Y,U))
+7 QUIT Y
GETAPPT(DFN,CLINIC,OCCLIM,INDEX,COUNT,LAST,EARLY,FUTURE) ; Get list
+1 DO GETAPPT^TIUVSIT1($GET(DFN),$GET(CLINIC),$GET(OCCLIM),$GET(INDEX),$GET(COUNT),$GET(LAST),$GET(EARLY),$GET(FUTURE))
+2 QUIT
