- TIULV ; SLC/JER - Visit/Movement related library ;Jan 26, 2024@07:17
- ;;1.0;TEXT INTEGRATION UTILITIES;**7,30,55,45,52,148,156,152,113,200,362**;Jun 20, 1997;Build 3
- ;
- ; Reference to File ^AUPNVSIT supported by ICR #3580
- ; Reference to File ^VA supported by ICR #10060
- ; Reference to File ^DG(40.8 supported by ICR #1576
- ; Reference to File ^DGPM supported by ICR #4076
- ; Reference to File ^DIC(42 supported by ICR #10039
- ; Reference to File ^DIC(49 supported by ICR #432
- ; Reference to File ^DPT supported by ICR #10035
- ; Reference to File ^SC( supported by ICR #93
- ; Reference to File ^VA supported by ICR #10060
- ; Reference to ^DIC supported by ICR #10006
- ; Reference to $$GET1^DIQ supported by ICR #2056
- ; Reference to *^DIQ1 supported by ICR #10015
- ; Reference to *^VADPT supported by ICR #10061
- ; Reference to *^VASITE supported by ICR #10112
- ;
- Q
- 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("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)
- 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("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
- . 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))
- . ; verify FACILITY TREATING SPECIALTY NAME, Field #2 SERVICE when setting "SVC" node *362 ajb
- . N TMPSVC S TMPSVC=+$$GET1^DIQ(45.7,+TIUY("TS"),2,"I",,"ERROR") S:+TMPSVC TIUY("SVC")=TMPSVC ; *362 ajb
- . S:+TMPSVC TIUY("SVC")=TIUY("SVC")_U_$$GET1^DIQ(49,+TIUY("SVC"),.01,"I",,"ERROR") ; *362 ajb
- . 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)
- . 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))
- ; 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="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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULV 6911 printed Jan 18, 2025@03:43:37 Page 2
- TIULV ; SLC/JER - Visit/Movement related library ;Jan 26, 2024@07:17
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**7,30,55,45,52,148,156,152,113,200,362**;Jun 20, 1997;Build 3
- +2 ;
- +3 ; Reference to File ^AUPNVSIT supported by ICR #3580
- +4 ; Reference to File ^VA supported by ICR #10060
- +5 ; Reference to File ^DG(40.8 supported by ICR #1576
- +6 ; Reference to File ^DGPM supported by ICR #4076
- +7 ; Reference to File ^DIC(42 supported by ICR #10039
- +8 ; Reference to File ^DIC(49 supported by ICR #432
- +9 ; Reference to File ^DPT supported by ICR #10035
- +10 ; Reference to File ^SC( supported by ICR #93
- +11 ; Reference to File ^VA supported by ICR #10060
- +12 ; Reference to ^DIC supported by ICR #10006
- +13 ; Reference to $$GET1^DIQ supported by ICR #2056
- +14 ; Reference to *^DIQ1 supported by ICR #10015
- +15 ; Reference to *^VADPT supported by ICR #10061
- +16 ; Reference to *^VASITE supported by ICR #10112
- +17 ;
- +18 QUIT
- 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 SET TIUY("DOB")="DOB:"_$$DATE^TIULS(+$GET(VADM(3)),"MM/DD/CCYY")
- +6 DO ADD^VADPT
- +7 IF $GET(VAPA(8))'=""
- SET TIUY("PH#")="Ph:"_VAPA(8)
- +8 IF $GET(VAPA(8))=""
- SET TIUY("PH#")="Ph: **UNKNOWN**"
- +9 ;Integration Name
- SET TIUY("INTNM")=$$NAME^VASITE
- +10 SET TIUY("SITE")=$PIECE($$SITE^VASITE,U,2)
- +11 SET TIUY("LOCP")="Pt Loc: "_$SELECT(VAIN(4)]"":$PIECE(VAIN(4),U,2)_" "_VAIN(5),1:"OUTPATIENT")
- +12 QUIT
- +13 ;
- 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 SET TIUY("AGE")=$GET(VADM(4))
- SET TIUY("PID")="("_$EXTRACT(TIUY("PNM"))_VA("BID")_")"
- +5 SET TIUY("DOB")=$GET(VADM(3))
- +6 DO ADD^VADPT
- +7 IF $GET(VAPA(8))'=""
- SET TIUY("PH#")=VAPA(8)
- +8 IF $GET(VAPA(8))=""
- SET TIUY("PH#")="**UNKNOWN**"
- +9 SET TIUY("SEX")=$GET(VADM(5))
- +10 ; Below TIU*148
- +11 IF +$GET(VADM(12))>0
- Begin DoDot:1
- +12 FOR TIUY("NUMRACE")=1:1:VADM(12)
- SET TIUY("RACE",TIUY("NUMRACE"))=$GET(VADM(12,TIUY("NUMRACE")))
- End DoDot:1
- +13 SET TIUY("RACENO")=+$GET(VADM(12))
- +14 IF +$GET(VADM(12))=0
- SET TIUY("RACE")=$GET(VADM(8))
- +15 IF +$GET(TIUSDC)
- SET TIUY("STOP")=$GET(TIUSDC)
- +16 IF +$GET(TIUD13(0))
- SET TIUY("REFDT")=+$GET(TIUD13(0))
- +17 IF +$GET(TIUMVN)
- IF $DATA(^DGPM(+TIUMVN))
- Begin DoDot:1
- +18 NEW VLOC,VDT,TIUDIV
- +19 SET VAIP("E")=TIUMVN
- DO 52^VADPT
- +20 SET TIUI=$SELECT(+$GET(VAIP(17,1)):17,1:14)
- +21 SET TIUY("CLAIM")=$GET(VAEL(7))
- SET TIUY("PMD")=$GET(VAIP(TIUI,5))
- +22 SET TIUY("AMD")=$GET(VAIP(18))
- SET TIUY("TS")=$GET(VAIP(TIUI,6))
- +23 ; verify FACILITY TREATING SPECIALTY NAME, Field #2 SERVICE when setting "SVC" node *362 ajb
- +24 ; *362 ajb
- NEW TMPSVC
- SET TMPSVC=+$$GET1^DIQ(45.7,+TIUY("TS"),2,"I",,"ERROR")
- if +TMPSVC
- SET TIUY("SVC")=TMPSVC
- +25 ; *362 ajb
- if +TMPSVC
- SET TIUY("SVC")=TIUY("SVC")_U_$$GET1^DIQ(49,+TIUY("SVC"),.01,"I",,"ERROR")
- +26 SET TIUY("WARD")=$$WARD($GET(VAIP(17)))
- +27 SET (TIUY("ADDT"),TIUY("EDT"))=$GET(VAIP(3))
- +28 IF +TIUY("WARD")
- SET TIUY("LOC")=$GET(^DIC(42,+TIUY("WARD"),44))
- +29 IF +$GET(TIUY("LOC"))
- Begin DoDot:2
- +30 SET TIUY("LOC")=TIUY("LOC")_U_$PIECE($GET(^SC(+TIUY("LOC"),0)),U)
- End DoDot:2
- +31 SET TIUY("ADDX")=$GET(VAIP(9))
- SET TIUY("LDT")=$GET(VAIP(17,1))
- +32 SET TIUY("AD#")=+$GET(VAIP(13))
- SET TIUY("MTYPE")=$GET(VAIP(TIUI,3))
- +33 SET TIUDIV=$PIECE($GET(^DIC(42,+TIUY("WARD"),0)),U,11)
- +34 IF +TIUDIV
- SET TIUY("DIV")=TIUDIV_U_$PIECE($GET(^DG(40.8,+TIUDIV,0)),U)
- +35 SET VDT=+VAIP(3)
- +36 SET VLOC=$GET(^DIC(42,+$PIECE($GET(VAIP(13,4)),U),44))
- +37 SET TIUY("VSTR")=VLOC_";"_+TIUY("EDT")_";H"
- +38 SET TIUY("VLOC")=VLOC_U_$PIECE($GET(^SC(VLOC,0)),U)
- +39 if '+$GET(TIUY("LOC"))
- SET TIUY("LOC")=TIUY("VLOC")
- End DoDot:1
- +40 IF $GET(TIUVSTR)]""
- SET TIUY("VSTR")=TIUVSTR
- DO VSIT(.TIUY,TIUVSTR)
- +41 IF '+$GET(TIUMVN)
- IF '+$GET(TIUVSTR)
- DO CURRENT(.TIUY,DFN)
- +42 ; D CURRENT(.TIUY,DFN)
- +43 IF +$$PROVIDER^TIUPXAP1($SELECT($DATA(TIUAUTH):+$GET(TIUAUTH),1:DUZ),+$GET(TIUY("EDT")))
- Begin DoDot:1
- +44 SET TIUY("SVC")=$$PROVSVC(+$SELECT($DATA(TIUAUTH):+$GET(TIUAUTH),1:DUZ))
- End DoDot:1
- +45 IF +$GET(TIUY("VSTR"))
- IF (+$ORDER(^TIU(8925,"AVSTRV",+DFN,$GET(TIUY("VSTR")),0))>0)
- Begin DoDot:1
- +46 NEW TIUVSIT
- SET TIUVSIT=+$ORDER(^TIU(8925,"AVSTRV",+DFN,$GET(TIUY("VSTR")),0))
- +47 IF $PIECE($GET(^AUPNVSIT(+TIUVSIT,0)),U,5)'=DFN
- KILL ^TIU(8925,"AVSTRV",+DFN,$GET(TIUY("VSTR")),TIUVSIT)
- QUIT
- +48 SET TIUY("VISIT")=+TIUVSIT_U_+$GET(^AUPNVSIT(+TIUVSIT,0))
- End DoDot:1
- +49 ; if pt an inpt + doc class is pn- default to current inpt loc
- +50 SET TIUTYPE=$SELECT(+$PIECE($GET(TIUTYP(1)),U,2)>0:$PIECE($GET(TIUTYP(1)),U,2),1:+$GET(TIUTYP))
- +51 IF +TIUTYPE'>0
- SET TIUY("INST")=$$DIVISION^TIULC1(+TIUY("LOC"))
- QUIT
- +52 IF +$GET(TIUMVN)
- IF $DATA(^DPT(DFN,.1))
- IF +$$ISPN^TIULX(TIUTYPE)
- Begin DoDot:1
- +53 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
- +54 SET TIUY("INST")=$$DIVISION^TIULC1(+TIUY("LOC"))
- +55 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 IF TIUCT]""
- SET TIUY("CAT")=TIUCT_U_$SELECT(TIUCT="A":"AMBULATORY",TIUCT="I":"IN HOSPITAL",TIUCT="H":"HOSPITALIZATION",TIUCT="T":"TELEPHONE",1:"EVENT (HISTORICAL)")
- +8 IF TIUCT="E"
- IF +$GET(TIUVSTR)'>0
- QUIT
- +9 SET TIUY("LVL")=$GET(TIUY("LVL"))
- +10 SET TIUY("ELG")=$GET(VAEL(1))
- +11 SET TIUY("VLOC")=+$GET(TIUVSTR)_U_$PIECE($GET(^SC(+$GET(TIUVSTR),0)),U)
- +12 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"))
- +13 if $PIECE(TIUY("LOC"),U,2)']""
- SET TIUY("LOC")=TIUY("LOC")_U_$PIECE($GET(^SC(+TIUY("LOC"),0)),U)
- +14 IF '$DATA(TIUY("DIV"))
- IF +$GET(TIUY("LOC"))
- Begin DoDot:1
- +15 NEW TIUDIV,DIC,DR,DA,DIQ,X,Y
- +16 SET DIC=44
- SET DIQ="TIUDIV"
- SET DIQ(0)="IE"
- SET DA=+TIUY("LOC")
- SET DR="3.5"
- DO EN^DIQ1
- +17 IF '+$GET(TIUDIV(44,+DA,3.5,"I"))
- QUIT
- +18 SET TIUY("DIV")=TIUDIV(44,+DA,3.5,"I")_U_TIUDIV(44,+DA,3.5,"E")
- End DoDot:1
- +19 IF '$DATA(TIUY("DIV"))
- IF '+$GET(TIUY("LOC"))
- Begin DoDot:1
- +20 SET TIUY("DIV")=+$ORDER(^DG(40.8,"AD",+$GET(DUZ(2)),0))
- +21 SET TIUY("DIV")=+TIUY("DIV")_U_$PIECE($GET(^DG(40.8,+$GET(TIUY("DIV")),0)),U)
- End DoDot:1
- +22 SET TIUY("INS")=$GET(TIUY("DIV"))
- +23 SET TIUY("SC")=$GET(TIUY("SC"))
- +24 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