Routine: TIUVSIT

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)

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)

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

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)

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

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

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)

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)

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)

REMFLAG(DA) ; Remove credit flag from TIU Document Record

 N DIE,DR,X,Y

 S DIE=8925,DR=".11///@" D ^DIE

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))

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

TIUVSIT.m