TIULV ; SLC/JER - Visit/Movement related library ;29-Apr-2014 15:01;DU
;;1.0;TEXT INTEGRATION UTILITIES;**7,30,55,45,52,148,156,152,113,1001,1007,1009,200,1011,1012**;Jun 20, 1997;Build 45
;IHS/ITSC/LJF 02/26/2003 set chart #, visit and facility fields
; used file DD to determine service category external format
; 04/08/2004 fixed code to prevent UNDEF if no ward
;IHS/ITSC/LJF 11/05/2004 PATCH 1001 if called by EHR, BTIUVSIT may not be set
PATPN(TIUY,DFN) ; Get minimum demographics for PN Print
N VADM,VAIP,VAIN,VA,VAPA
D OERR^VADPT
S TIUY("PNMP")=$E($G(VADM(1)),1,30)
S TIUY("SSN")=$G(VA("PID"))
S TIUY("HRCN")=$G(HRCN) ;IHS/ITSC/LJF 02/26/2003 set chart#
S TIUY("DOB")="DOB:"_$$DATE^TIULS(+$G(VADM(3)),"MM/DD/CCYY")
D ADD^VADPT
I $G(VAPA(8))'="" S TIUY("PH#")="Ph:"_VAPA(8)
I $G(VAPA(8))="" S TIUY("PH#")="Ph: **UNKNOWN**"
S TIUY("INTNM")=$$NAME^VASITE ;Integration Name
;S TIUY("SITE")=$P($$SITE^VASITE,U,2) ;IHS/ITSC/LJF 02/26/2003
S TIUY("SITE")=$$GET1^DIQ(4,DUZ(2),.01) ;IHS/ITSC/LJF 02/26/2003 get facility name
S TIUY("LOCP")="Pt Loc: "_$S(VAIN(4)]"":$P(VAIN(4),U,2)_" "_VAIN(5),1:"OUTPATIENT")
Q
;
PATVADPT(TIUY,DFN,TIUMVN,TIUVSTR,TIUSDC) ; Extract MAS data
N VA,VADM,VAEL,VAERR,VAIP,TIUI,TIUWARD,X,Y,TIUTYPE,TIUFTS,TIUSS,VAPA
D DEM^VADPT
S TIUY("PNM")=$G(VADM(1)),TIUY("SSN")=$G(VA("PID"))
S TIUY("HRCN")=$G(HRCN) ;IHS/ITSC/LJF 02/26/2003 set chart #
S TIUY("AGE")=$G(VADM(4)),TIUY("PID")="("_$E(TIUY("PNM"))_VA("BID")_")"
S TIUY("DOB")=$G(VADM(3))
D ADD^VADPT
I $G(VAPA(8))'="" S TIUY("PH#")=VAPA(8)
I $G(VAPA(8))="" S TIUY("PH#")="**UNKNOWN**"
S TIUY("SEX")=$G(VADM(5))
; Below TIU*148
I +$G(VADM(12))>0 D
. F TIUY("NUMRACE")=1:1:VADM(12) S TIUY("RACE",TIUY("NUMRACE"))=$G(VADM(12,TIUY("NUMRACE")))
S TIUY("RACENO")=+$G(VADM(12))
I +$G(VADM(12))=0 S TIUY("RACE")=$G(VADM(8))
I +$G(TIUSDC) S TIUY("STOP")=$G(TIUSDC)
I +$G(TIUD13(0)) S TIUY("REFDT")=+$G(TIUD13(0))
I +$G(TIUMVN),$D(^DGPM(+TIUMVN)) D
. ; N VLOC,VDT,TIUDIV
. N VLOC,VDT,TIUDIV
. S VAIP("E")=TIUMVN D 52^VADPT
. S TIUI=$S(+$G(VAIP(17,1)):17,1:14)
. S TIUY("CLAIM")=$G(VAEL(7)),TIUY("PMD")=$G(VAIP(TIUI,5))
. S TIUY("AMD")=$G(VAIP(18)),TIUY("TS")=$G(VAIP(TIUI,6))
. S TIUY("SVC")=+$$GET1^DIQ(45.7,+TIUY("TS"),2,"I",,"ERROR")
. S TIUY("SVC")=TIUY("SVC")_U_$$GET1^DIQ(49,+TIUY("SVC"),.01,"I",,"ERROR")
. S TIUY("WARD")=$$WARD($G(VAIP(17)))
. S (TIUY("ADDT"),TIUY("EDT"))=$G(VAIP(3))
. I +TIUY("WARD") S TIUY("LOC")=$G(^DIC(42,+TIUY("WARD"),44))
. I +$G(TIUY("LOC")) D
. . S TIUY("LOC")=TIUY("LOC")_U_$P($G(^SC(+TIUY("LOC"),0)),U)
. S TIUY("ADDX")=$G(VAIP(9)),TIUY("LDT")=$G(VAIP(17,1))
. S TIUY("AD#")=+$G(VAIP(13)),TIUY("MTYPE")=$G(VAIP(TIUI,3))
. S TIUDIV=$P($G(^DIC(42,+TIUY("WARD"),0)),U,11)
. I +TIUDIV S TIUY("DIV")=TIUDIV_U_$P($G(^DG(40.8,+TIUDIV,0)),U)
. S VDT=+VAIP(3)
. S VLOC=$G(^DIC(42,+$P($G(VAIP(13,4)),U),44))
. S TIUY("VSTR")=VLOC_";"_+TIUY("EDT")_";H"
. ;S TIUY("VLOC")=VLOC_U_$P($G(^SC(VLOC,0)),U) ;IHS/ITSC/LJF
. S TIUY("VLOC")=VLOC_U_$P($G(^SC(+VLOC,0)),U) ;IHS/ITSC/LJF 4/8/2004 prevent UNDEF
. S:'+$G(TIUY("LOC")) TIUY("LOC")=TIUY("VLOC")
I $G(TIUVSTR)]"" S TIUY("VSTR")=TIUVSTR D VSIT(.TIUY,TIUVSTR)
I '+$G(TIUMVN),'+$G(TIUVSTR) D CURRENT(.TIUY,DFN)
; D CURRENT(.TIUY,DFN)
I +$$PROVIDER^TIUPXAP1($S($D(TIUAUTH):+$G(TIUAUTH),1:DUZ),+$G(TIUY("EDT"))) D
. S TIUY("SVC")=$$PROVSVC(+$S($D(TIUAUTH):+$G(TIUAUTH),1:DUZ))
I +$G(TIUY("VSTR")),(+$O(^TIU(8925,"AVSTRV",+DFN,$G(TIUY("VSTR")),0))>0) D
. N TIUVSIT S TIUVSIT=+$O(^TIU(8925,"AVSTRV",+DFN,$G(TIUY("VSTR")),0))
. I $P($G(^AUPNVSIT(+TIUVSIT,0)),U,5)'=DFN K ^TIU(8925,"AVSTRV",+DFN,$G(TIUY("VSTR")),TIUVSIT) Q
. S TIUY("VISIT")=+TIUVSIT_U_+$G(^AUPNVSIT(+TIUVSIT,0))
;
;IHS/ITSC/LJF 02/26/2003 setting of variables from IHS data
I '$G(BTIUVSIT),$G(TIUMVN) NEW BTIUVSIT S BTIUVSIT=$$GET1^DIQ(405,TIUMVN,.27,"I") ;visit ien
;IHS/ITSC/LJF 11/05/2004 PATCH 1001 if called by EHR, BTIUVSIT may not be set
I $G(BTIUVSIT)<1,$G(TIUVSIT)>0 S TIUY("VISIT")=(+TIUVSIT)_U_+$G(^AUPNVSIT(+TIUVSIT,0))
E S TIUY("VISIT")=+$G(BTIUVSIT)_U_+$G(^AUPNVSIT(+$G(BTIUVSIT),0))
;end of PATCH 1001 change
;
I '$D(TIUY("DIV")) S TIUY("DIV")=+$O(^DG(40.8,"AD",DUZ(2),0))_U_$$GET1^DIQ(4,DUZ(2),.01) ;IHS/MSC/MGH Patch 1012
;IHS/ITSC/LJF 02/26/2003 end of new code
;
; if pt an inpt + doc class is pn- default to current inpt loc
S TIUTYPE=$S(+$P($G(TIUTYP(1)),U,2)>0:$P($G(TIUTYP(1)),U,2),1:+$G(TIUTYP))
I +TIUTYPE'>0 S TIUY("INST")=$$DIVISION^TIULC1(+TIUY("LOC")) Q
I +$G(TIUMVN),$D(^DPT(DFN,.1)),+$$ISPN^TIULX(TIUTYPE) D
. I $D(VAIP(14,4)) S TIUY("LOC")=$G(^DIC(42,+VAIP(14,4),44))_U_$P(VAIP(14,4),U,2)
S TIUY("INST")=$$DIVISION^TIULC1(+TIUY("LOC"))
Q
WARD(DA) ; Compute ward at discharge
N %,D0,DIC,DIQ,DR,MOVE,X,Y
I +DA'>0 S Y=$G(VAIP(TIUI,4)) G WARDX
S DIC="^DGPM(",DIQ(0)="IE",DIQ="MOVE(",DR=200
D EN^DIQ1
S X=$G(MOVE(405,DA,200,"E")),DIC=42,DIC(0)="X" D ^DIC
I +Y'>0 S Y=""
WARDX Q Y
PROVSVC(TIUSER) ; Resolve user's Service
N TIUY
S TIUY=$P($G(^VA(200,+TIUSER,5)),U)
S:+TIUY TIUY=TIUY_U_$P(^DIC(49,+TIUY,0),U)
Q TIUY
VSIT(TIUY,TIUVSTR) ; Get Visit related info
N DIC,DIQ,X,Y,DA,DR,VSIT,TIUCT,VAEL,VAERR
D ELIG^VADPT
I '$D(TIUY("EDT")) D
. S TIUY("EDT")=$P(TIUVSTR,";",2)_U_$$DATE^TIULS($P(TIUVSTR,";",2),"AMTH DD, CCYY@HR:MIN")
S TIUY("LDT")=$G(TIUY("LDT"))
S TIUCT=$P(TIUVSTR,";",3)
;I TIUCT]"" S TIUY("CAT")=TIUCT_U_$S(TIUCT="A":"AMBULATORY",TIUCT="I":"IN HOSPITAL",TIUCT="H":"HOSPITALIZATION",TIUCT="T":"TELEPHONE",1:"EVENT (HISTORICAL)")
I TIUCT]"" NEW C,Y S C=$P(^DD(9000010,.07,0),U,2),Y=TIUCT D Y^DIQ S TIUY("CAT")=TIUCT_U_Y ;IHS/ITSC/LJF 02/26/2003 use all possible choices in file
I TIUCT="E",+$G(TIUVSTR)'>0 Q
S TIUY("LVL")=$G(TIUY("LVL"))
S TIUY("ELG")=$G(VAEL(1))
S TIUY("VLOC")=+$G(TIUVSTR)_U_$P($G(^SC(+$G(TIUVSTR),0)),U)
I $G(TIUY("LOC"))']"" S TIUY("LOC")=$S($L($G(TIUD12)):$P($G(TIUD12),U,5),+$G(TIUDA):+$P($G(^TIU(8925,+$G(TIUDA),12)),U,5),1:+TIUY("VLOC"))
S:$P(TIUY("LOC"),U,2)']"" TIUY("LOC")=TIUY("LOC")_U_$P($G(^SC(+TIUY("LOC"),0)),U)
I '$D(TIUY("DIV")),+$G(TIUY("LOC")) D
. N TIUDIV,DIC,DR,DA,DIQ,X,Y
. S DIC=44,DIQ="TIUDIV",DIQ(0)="IE",DA=+TIUY("LOC"),DR="3.5" D EN^DIQ1
. I '+$G(TIUDIV(44,+DA,3.5,"I")) Q
. S TIUY("DIV")=TIUDIV(44,+DA,3.5,"I")_U_TIUDIV(44,+DA,3.5,"E")
I '$D(TIUY("DIV")),'+$G(TIUY("LOC")) D
. S TIUY("DIV")=+$O(^DG(40.8,"AD",+$G(DUZ(2)),0))
. S TIUY("DIV")=+TIUY("DIV")_U_$P($G(^DG(40.8,+$G(TIUY("DIV")),0)),U)
S TIUY("INS")=$G(TIUY("DIV"))
S TIUY("SC")=$G(TIUY("SC"))
Q
CURRENT(TIUY,DFN) ; Get current INPATIENT data
N VAIN D INP^VADPT
S TIUY("AD#")=$G(VAIN(1)),TIUY("PMD")=$G(VAIN(2))
S TIUY("TS")=$G(VAIN(3)),TIUY("WARD")=$G(VAIN(4),"0^OUTPATIENT")
S TIUY("RB")=$G(VAIN(5))
I +TIUY("WARD") D
. N DIC,DIQ,DR,DA,TIUDIV,Y
. S DIC=42,DA=+TIUY("WARD"),DIQ="TIUDIV(",DIQ(0)="IE",DR=".015;44"
. D EN^DIQ1
. S TIUY("DIV")=$G(TIUDIV(42,DA,.015,"I"))_U_$G(TIUDIV(42,DA,.015,"E"))
. S TIUY("LOC")=$G(TIUDIV(42,DA,44,"I"))_U_$G(TIUDIV(42,DA,44,"E"))
S TIUY("LOC")=$G(TIUY("LOC"))
I '+$G(TIUY("DIV")) D
. N DIC,DIQ,DR,DA
. S DIC=4,DR=".01",DA=+$G(DUZ(2)),DIQ="TIUDIV1"
. D EN^DIQ1
. ;TIU*1*152 changed TIUDIV1(4,DUZ(2),.01) to $G(TIUDIV1(4,$G(DUZ(2)),.01)) ; TIU*1*200 Added + to 2nd piece and + to $G(DUZ(2))
. S TIUY("DIV")=+$G(DUZ(2))_U_+$G(TIUDIV1(4,+$G(DUZ(2)),.01))
Q
TIULV ; SLC/JER - Visit/Movement related library ;29-Apr-2014 15:01;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**7,30,55,45,52,148,156,152,113,1001,1007,1009,200,1011,1012**;Jun 20, 1997;Build 45
+2 ;IHS/ITSC/LJF 02/26/2003 set chart #, visit and facility fields
+3 ; used file DD to determine service category external format
+4 ; 04/08/2004 fixed code to prevent UNDEF if no ward
+5 ;IHS/ITSC/LJF 11/05/2004 PATCH 1001 if called by EHR, BTIUVSIT may not be set
PATPN(TIUY,DFN) ; Get minimum demographics for PN Print
+1 NEW VADM,VAIP,VAIN,VA,VAPA
+2 DO OERR^VADPT
+3 SET TIUY("PNMP")=$EXTRACT($GET(VADM(1)),1,30)
+4 SET TIUY("SSN")=$GET(VA("PID"))
+5 ;IHS/ITSC/LJF 02/26/2003 set chart#
SET TIUY("HRCN")=$GET(HRCN)
+6 SET TIUY("DOB")="DOB:"_$$DATE^TIULS(+$GET(VADM(3)),"MM/DD/CCYY")
+7 DO ADD^VADPT
+8 IF $GET(VAPA(8))'=""
SET TIUY("PH#")="Ph:"_VAPA(8)
+9 IF $GET(VAPA(8))=""
SET TIUY("PH#")="Ph: **UNKNOWN**"
+10 ;Integration Name
SET TIUY("INTNM")=$$NAME^VASITE
+11 ;S TIUY("SITE")=$P($$SITE^VASITE,U,2) ;IHS/ITSC/LJF 02/26/2003
+12 ;IHS/ITSC/LJF 02/26/2003 get facility name
SET TIUY("SITE")=$$GET1^DIQ(4,DUZ(2),.01)
+13 SET TIUY("LOCP")="Pt Loc: "_$SELECT(VAIN(4)]"":$PIECE(VAIN(4),U,2)_" "_VAIN(5),1:"OUTPATIENT")
+14 QUIT
+15 ;
PATVADPT(TIUY,DFN,TIUMVN,TIUVSTR,TIUSDC) ; Extract MAS data
+1 NEW VA,VADM,VAEL,VAERR,VAIP,TIUI,TIUWARD,X,Y,TIUTYPE,TIUFTS,TIUSS,VAPA
+2 DO DEM^VADPT
+3 SET TIUY("PNM")=$GET(VADM(1))
SET TIUY("SSN")=$GET(VA("PID"))
+4 ;IHS/ITSC/LJF 02/26/2003 set chart #
SET TIUY("HRCN")=$GET(HRCN)
+5 SET TIUY("AGE")=$GET(VADM(4))
SET TIUY("PID")="("_$EXTRACT(TIUY("PNM"))_VA("BID")_")"
+6 SET TIUY("DOB")=$GET(VADM(3))
+7 DO ADD^VADPT
+8 IF $GET(VAPA(8))'=""
SET TIUY("PH#")=VAPA(8)
+9 IF $GET(VAPA(8))=""
SET TIUY("PH#")="**UNKNOWN**"
+10 SET TIUY("SEX")=$GET(VADM(5))
+11 ; Below TIU*148
+12 IF +$GET(VADM(12))>0
Begin DoDot:1
+13 FOR TIUY("NUMRACE")=1:1:VADM(12)
SET TIUY("RACE",TIUY("NUMRACE"))=$GET(VADM(12,TIUY("NUMRACE")))
End DoDot:1
+14 SET TIUY("RACENO")=+$GET(VADM(12))
+15 IF +$GET(VADM(12))=0
SET TIUY("RACE")=$GET(VADM(8))
+16 IF +$GET(TIUSDC)
SET TIUY("STOP")=$GET(TIUSDC)
+17 IF +$GET(TIUD13(0))
SET TIUY("REFDT")=+$GET(TIUD13(0))
+18 IF +$GET(TIUMVN)
IF $DATA(^DGPM(+TIUMVN))
Begin DoDot:1
+19 ; N VLOC,VDT,TIUDIV
+20 NEW VLOC,VDT,TIUDIV
+21 SET VAIP("E")=TIUMVN
DO 52^VADPT
+22 SET TIUI=$SELECT(+$GET(VAIP(17,1)):17,1:14)
+23 SET TIUY("CLAIM")=$GET(VAEL(7))
SET TIUY("PMD")=$GET(VAIP(TIUI,5))
+24 SET TIUY("AMD")=$GET(VAIP(18))
SET TIUY("TS")=$GET(VAIP(TIUI,6))
+25 SET TIUY("SVC")=+$$GET1^DIQ(45.7,+TIUY("TS"),2,"I",,"ERROR")
+26 SET TIUY("SVC")=TIUY("SVC")_U_$$GET1^DIQ(49,+TIUY("SVC"),.01,"I",,"ERROR")
+27 SET TIUY("WARD")=$$WARD($GET(VAIP(17)))
+28 SET (TIUY("ADDT"),TIUY("EDT"))=$GET(VAIP(3))
+29 IF +TIUY("WARD")
SET TIUY("LOC")=$GET(^DIC(42,+TIUY("WARD"),44))
+30 IF +$GET(TIUY("LOC"))
Begin DoDot:2
+31 SET TIUY("LOC")=TIUY("LOC")_U_$PIECE($GET(^SC(+TIUY("LOC"),0)),U)
End DoDot:2
+32 SET TIUY("ADDX")=$GET(VAIP(9))
SET TIUY("LDT")=$GET(VAIP(17,1))
+33 SET TIUY("AD#")=+$GET(VAIP(13))
SET TIUY("MTYPE")=$GET(VAIP(TIUI,3))
+34 SET TIUDIV=$PIECE($GET(^DIC(42,+TIUY("WARD"),0)),U,11)
+35 IF +TIUDIV
SET TIUY("DIV")=TIUDIV_U_$PIECE($GET(^DG(40.8,+TIUDIV,0)),U)
+36 SET VDT=+VAIP(3)
+37 SET VLOC=$GET(^DIC(42,+$PIECE($GET(VAIP(13,4)),U),44))
+38 SET TIUY("VSTR")=VLOC_";"_+TIUY("EDT")_";H"
+39 ;S TIUY("VLOC")=VLOC_U_$P($G(^SC(VLOC,0)),U) ;IHS/ITSC/LJF
+40 ;IHS/ITSC/LJF 4/8/2004 prevent UNDEF
SET TIUY("VLOC")=VLOC_U_$PIECE($GET(^SC(+VLOC,0)),U)
+41 IF '+$GET(TIUY("LOC"))
SET TIUY("LOC")=TIUY("VLOC")
End DoDot:1
+42 IF $GET(TIUVSTR)]""
SET TIUY("VSTR")=TIUVSTR
DO VSIT(.TIUY,TIUVSTR)
+43 IF '+$GET(TIUMVN)
IF '+$GET(TIUVSTR)
DO CURRENT(.TIUY,DFN)
+44 ; D CURRENT(.TIUY,DFN)
+45 IF +$$PROVIDER^TIUPXAP1($SELECT($DATA(TIUAUTH):+$GET(TIUAUTH),1:DUZ),+$GET(TIUY("EDT")))
Begin DoDot:1
+46 SET TIUY("SVC")=$$PROVSVC(+$SELECT($DATA(TIUAUTH):+$GET(TIUAUTH),1:DUZ))
End DoDot:1
+47 IF +$GET(TIUY("VSTR"))
IF (+$ORDER(^TIU(8925,"AVSTRV",+DFN,$GET(TIUY("VSTR")),0))>0)
Begin DoDot:1
+48 NEW TIUVSIT
SET TIUVSIT=+$ORDER(^TIU(8925,"AVSTRV",+DFN,$GET(TIUY("VSTR")),0))
+49 IF $PIECE($GET(^AUPNVSIT(+TIUVSIT,0)),U,5)'=DFN
KILL ^TIU(8925,"AVSTRV",+DFN,$GET(TIUY("VSTR")),TIUVSIT)
QUIT
+50 SET TIUY("VISIT")=+TIUVSIT_U_+$GET(^AUPNVSIT(+TIUVSIT,0))
End DoDot:1
+51 ;
+52 ;IHS/ITSC/LJF 02/26/2003 setting of variables from IHS data
+53 ;visit ien
IF '$GET(BTIUVSIT)
IF $GET(TIUMVN)
NEW BTIUVSIT
SET BTIUVSIT=$$GET1^DIQ(405,TIUMVN,.27,"I")
+54 ;IHS/ITSC/LJF 11/05/2004 PATCH 1001 if called by EHR, BTIUVSIT may not be set
+55 IF $GET(BTIUVSIT)<1
IF $GET(TIUVSIT)>0
SET TIUY("VISIT")=(+TIUVSIT)_U_+$GET(^AUPNVSIT(+TIUVSIT,0))
+56 IF '$TEST
SET TIUY("VISIT")=+$GET(BTIUVSIT)_U_+$GET(^AUPNVSIT(+$GET(BTIUVSIT),0))
+57 ;end of PATCH 1001 change
+58 ;
+59 ;IHS/MSC/MGH Patch 1012
IF '$DATA(TIUY("DIV"))
SET TIUY("DIV")=+$ORDER(^DG(40.8,"AD",DUZ(2),0))_U_$$GET1^DIQ(4,DUZ(2),.01)
+60 ;IHS/ITSC/LJF 02/26/2003 end of new code
+61 ;
+62 ; if pt an inpt + doc class is pn- default to current inpt loc
+63 SET TIUTYPE=$SELECT(+$PIECE($GET(TIUTYP(1)),U,2)>0:$PIECE($GET(TIUTYP(1)),U,2),1:+$GET(TIUTYP))
+64 IF +TIUTYPE'>0
SET TIUY("INST")=$$DIVISION^TIULC1(+TIUY("LOC"))
QUIT
+65 IF +$GET(TIUMVN)
IF $DATA(^DPT(DFN,.1))
IF +$$ISPN^TIULX(TIUTYPE)
Begin DoDot:1
+66 IF $DATA(VAIP(14,4))
SET TIUY("LOC")=$GET(^DIC(42,+VAIP(14,4),44))_U_$PIECE(VAIP(14,4),U,2)
End DoDot:1
+67 SET TIUY("INST")=$$DIVISION^TIULC1(+TIUY("LOC"))
+68 QUIT
WARD(DA) ; Compute ward at discharge
+1 NEW %,D0,DIC,DIQ,DR,MOVE,X,Y
+2 IF +DA'>0
SET Y=$GET(VAIP(TIUI,4))
GOTO WARDX
+3 SET DIC="^DGPM("
SET DIQ(0)="IE"
SET DIQ="MOVE("
SET DR=200
+4 DO EN^DIQ1
+5 SET X=$GET(MOVE(405,DA,200,"E"))
SET DIC=42
SET DIC(0)="X"
DO ^DIC
+6 IF +Y'>0
SET Y=""
WARDX QUIT Y
PROVSVC(TIUSER) ; Resolve user's Service
+1 NEW TIUY
+2 SET TIUY=$PIECE($GET(^VA(200,+TIUSER,5)),U)
+3 IF +TIUY
SET TIUY=TIUY_U_$PIECE(^DIC(49,+TIUY,0),U)
+4 QUIT TIUY
VSIT(TIUY,TIUVSTR) ; Get Visit related info
+1 NEW DIC,DIQ,X,Y,DA,DR,VSIT,TIUCT,VAEL,VAERR
+2 DO ELIG^VADPT
+3 IF '$DATA(TIUY("EDT"))
Begin DoDot:1
+4 SET TIUY("EDT")=$PIECE(TIUVSTR,";",2)_U_$$DATE^TIULS($PIECE(TIUVSTR,";",2),"AMTH DD, CCYY@HR:MIN")
End DoDot:1
+5 SET TIUY("LDT")=$GET(TIUY("LDT"))
+6 SET TIUCT=$PIECE(TIUVSTR,";",3)
+7 ;I TIUCT]"" S TIUY("CAT")=TIUCT_U_$S(TIUCT="A":"AMBULATORY",TIUCT="I":"IN HOSPITAL",TIUCT="H":"HOSPITALIZATION",TIUCT="T":"TELEPHONE",1:"EVENT (HISTORICAL)")
+8 ;IHS/ITSC/LJF 02/26/2003 use all possible choices in file
IF TIUCT]""
NEW C,Y
SET C=$PIECE(^DD(9000010,.07,0),U,2)
SET Y=TIUCT
DO Y^DIQ
SET TIUY("CAT")=TIUCT_U_Y
+9 IF TIUCT="E"
IF +$GET(TIUVSTR)'>0
QUIT
+10 SET TIUY("LVL")=$GET(TIUY("LVL"))
+11 SET TIUY("ELG")=$GET(VAEL(1))
+12 SET TIUY("VLOC")=+$GET(TIUVSTR)_U_$PIECE($GET(^SC(+$GET(TIUVSTR),0)),U)
+13 IF $GET(TIUY("LOC"))']""
SET TIUY("LOC")=$SELECT($LENGTH($GET(TIUD12)):$PIECE($GET(TIUD12),U,5),+$GET(TIUDA):+$PIECE($GET(^TIU(8925,+$GET(TIUDA),12)),U,5),1:+TIUY("VLOC"))
+14 IF $PIECE(TIUY("LOC"),U,2)']""
SET TIUY("LOC")=TIUY("LOC")_U_$PIECE($GET(^SC(+TIUY("LOC"),0)),U)
+15 IF '$DATA(TIUY("DIV"))
IF +$GET(TIUY("LOC"))
Begin DoDot:1
+16 NEW TIUDIV,DIC,DR,DA,DIQ,X,Y
+17 SET DIC=44
SET DIQ="TIUDIV"
SET DIQ(0)="IE"
SET DA=+TIUY("LOC")
SET DR="3.5"
DO EN^DIQ1
+18 IF '+$GET(TIUDIV(44,+DA,3.5,"I"))
QUIT
+19 SET TIUY("DIV")=TIUDIV(44,+DA,3.5,"I")_U_TIUDIV(44,+DA,3.5,"E")
End DoDot:1
+20 IF '$DATA(TIUY("DIV"))
IF '+$GET(TIUY("LOC"))
Begin DoDot:1
+21 SET TIUY("DIV")=+$ORDER(^DG(40.8,"AD",+$GET(DUZ(2)),0))
+22 SET TIUY("DIV")=+TIUY("DIV")_U_$PIECE($GET(^DG(40.8,+$GET(TIUY("DIV")),0)),U)
End DoDot:1
+23 SET TIUY("INS")=$GET(TIUY("DIV"))
+24 SET TIUY("SC")=$GET(TIUY("SC"))
+25 QUIT
CURRENT(TIUY,DFN) ; Get current INPATIENT data
+1 NEW VAIN
DO INP^VADPT
+2 SET TIUY("AD#")=$GET(VAIN(1))
SET TIUY("PMD")=$GET(VAIN(2))
+3 SET TIUY("TS")=$GET(VAIN(3))
SET TIUY("WARD")=$GET(VAIN(4),"0^OUTPATIENT")
+4 SET TIUY("RB")=$GET(VAIN(5))
+5 IF +TIUY("WARD")
Begin DoDot:1
+6 NEW DIC,DIQ,DR,DA,TIUDIV,Y
+7 SET DIC=42
SET DA=+TIUY("WARD")
SET DIQ="TIUDIV("
SET DIQ(0)="IE"
SET DR=".015;44"
+8 DO EN^DIQ1
+9 SET TIUY("DIV")=$GET(TIUDIV(42,DA,.015,"I"))_U_$GET(TIUDIV(42,DA,.015,"E"))
+10 SET TIUY("LOC")=$GET(TIUDIV(42,DA,44,"I"))_U_$GET(TIUDIV(42,DA,44,"E"))
End DoDot:1
+11 SET TIUY("LOC")=$GET(TIUY("LOC"))
+12 IF '+$GET(TIUY("DIV"))
Begin DoDot:1
+13 NEW DIC,DIQ,DR,DA
+14 SET DIC=4
SET DR=".01"
SET DA=+$GET(DUZ(2))
SET DIQ="TIUDIV1"
+15 DO EN^DIQ1
+16 ;TIU*1*152 changed TIUDIV1(4,DUZ(2),.01) to $G(TIUDIV1(4,$G(DUZ(2)),.01)) ; TIU*1*200 Added + to 2nd piece and + to $G(DUZ(2))
+17 SET TIUY("DIV")=+$GET(DUZ(2))_U_+$GET(TIUDIV1(4,+$GET(DUZ(2)),.01))
End DoDot:1
+18 QUIT
