TIUVSIT ; SLC/JER - Interactive Visit look-up; 28-OCT-2003 [1/27/05 12:35pm]
 ;;1.0;TEXT INTEGRATION UTILITIES;**39,91,107,117,179,190**;Jun 20, 1997;Build 1
ENPN(TIUY,DFN,ALLOWNEW) ; Entry point for Progress Notes
 N DIRUT,DUOUT,DTOUT,TIULOC,TIUINOUT
 I +$G(DFN)'>0 Q
 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) ;Control
 N TIUFUTUR
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)
 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
 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:",!
 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",!
 W:'(TIUII#20) "<M>ORE VISITS, " W "<U>NSCHEDULED 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 ": " W:$D(TIUPICK) $P(^TMP("TIUVN",$J,TIUPICK),U),"// " R X:DTIME
 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["?" 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
 I $S(X="U":1,X["UNS":1,1:0) Q
 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
 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
 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")
 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
 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