Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIULV

TIULV.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference to File ^AUPNVSIT supported by ICR #3580
  1. ; Reference to File ^VA supported by ICR #10060
  1. ; Reference to File ^DG(40.8 supported by ICR #1576
  1. ; Reference to File ^DGPM supported by ICR #4076
  1. ; Reference to File ^DIC(42 supported by ICR #10039
  1. ; Reference to File ^DIC(49 supported by ICR #432
  1. ; Reference to File ^DPT supported by ICR #10035
  1. ; Reference to File ^SC( supported by ICR #93
  1. ; Reference to File ^VA supported by ICR #10060
  1. ; Reference to ^DIC supported by ICR #10006
  1. ; Reference to $$GET1^DIQ supported by ICR #2056
  1. ; Reference to *^DIQ1 supported by ICR #10015
  1. ; Reference to *^VADPT supported by ICR #10061
  1. ; Reference to *^VASITE supported by ICR #10112
  1. ;
  1. Q
  1. PATPN(TIUY,DFN) ; Get minimum demographics for PN Print
  1. N VADM,VAIP,VAIN,VA,VAPA
  1. D OERR^VADPT
  1. S TIUY("PNMP")=$E($G(VADM(1)),1,30)
  1. S TIUY("SSN")=$G(VA("PID"))
  1. S TIUY("DOB")="DOB:"_$$DATE^TIULS(+$G(VADM(3)),"MM/DD/CCYY")
  1. D ADD^VADPT
  1. I $G(VAPA(8))'="" S TIUY("PH#")="Ph:"_VAPA(8)
  1. I $G(VAPA(8))="" S TIUY("PH#")="Ph: **UNKNOWN**"
  1. S TIUY("INTNM")=$$NAME^VASITE ;Integration Name
  1. S TIUY("SITE")=$P($$SITE^VASITE,U,2)
  1. S TIUY("LOCP")="Pt Loc: "_$S(VAIN(4)]"":$P(VAIN(4),U,2)_" "_VAIN(5),1:"OUTPATIENT")
  1. Q
  1. ;
  1. PATVADPT(TIUY,DFN,TIUMVN,TIUVSTR,TIUSDC) ; Extract MAS data
  1. N VA,VADM,VAEL,VAERR,VAIP,TIUI,TIUWARD,X,Y,TIUTYPE,TIUFTS,TIUSS,VAPA
  1. D DEM^VADPT
  1. S TIUY("PNM")=$G(VADM(1)),TIUY("SSN")=$G(VA("PID"))
  1. S TIUY("AGE")=$G(VADM(4)),TIUY("PID")="("_$E(TIUY("PNM"))_VA("BID")_")"
  1. S TIUY("DOB")=$G(VADM(3))
  1. D ADD^VADPT
  1. I $G(VAPA(8))'="" S TIUY("PH#")=VAPA(8)
  1. I $G(VAPA(8))="" S TIUY("PH#")="**UNKNOWN**"
  1. S TIUY("SEX")=$G(VADM(5))
  1. ; Below TIU*148
  1. I +$G(VADM(12))>0 D
  1. . F TIUY("NUMRACE")=1:1:VADM(12) S TIUY("RACE",TIUY("NUMRACE"))=$G(VADM(12,TIUY("NUMRACE")))
  1. S TIUY("RACENO")=+$G(VADM(12))
  1. I +$G(VADM(12))=0 S TIUY("RACE")=$G(VADM(8))
  1. I +$G(TIUSDC) S TIUY("STOP")=$G(TIUSDC)
  1. I +$G(TIUD13(0)) S TIUY("REFDT")=+$G(TIUD13(0))
  1. I +$G(TIUMVN),$D(^DGPM(+TIUMVN)) D
  1. . N VLOC,VDT,TIUDIV
  1. . S VAIP("E")=TIUMVN D 52^VADPT
  1. . S TIUI=$S(+$G(VAIP(17,1)):17,1:14)
  1. . S TIUY("CLAIM")=$G(VAEL(7)),TIUY("PMD")=$G(VAIP(TIUI,5))
  1. . S TIUY("AMD")=$G(VAIP(18)),TIUY("TS")=$G(VAIP(TIUI,6))
  1. . ; verify FACILITY TREATING SPECIALTY NAME, Field #2 SERVICE when setting "SVC" node *362 ajb
  1. . N TMPSVC S TMPSVC=+$$GET1^DIQ(45.7,+TIUY("TS"),2,"I",,"ERROR") S:+TMPSVC TIUY("SVC")=TMPSVC ; *362 ajb
  1. . S:+TMPSVC TIUY("SVC")=TIUY("SVC")_U_$$GET1^DIQ(49,+TIUY("SVC"),.01,"I",,"ERROR") ; *362 ajb
  1. . S TIUY("WARD")=$$WARD($G(VAIP(17)))
  1. . S (TIUY("ADDT"),TIUY("EDT"))=$G(VAIP(3))
  1. . I +TIUY("WARD") S TIUY("LOC")=$G(^DIC(42,+TIUY("WARD"),44))
  1. . I +$G(TIUY("LOC")) D
  1. . . S TIUY("LOC")=TIUY("LOC")_U_$P($G(^SC(+TIUY("LOC"),0)),U)
  1. . S TIUY("ADDX")=$G(VAIP(9)),TIUY("LDT")=$G(VAIP(17,1))
  1. . S TIUY("AD#")=+$G(VAIP(13)),TIUY("MTYPE")=$G(VAIP(TIUI,3))
  1. . S TIUDIV=$P($G(^DIC(42,+TIUY("WARD"),0)),U,11)
  1. . I +TIUDIV S TIUY("DIV")=TIUDIV_U_$P($G(^DG(40.8,+TIUDIV,0)),U)
  1. . S VDT=+VAIP(3)
  1. . S VLOC=$G(^DIC(42,+$P($G(VAIP(13,4)),U),44))
  1. . S TIUY("VSTR")=VLOC_";"_+TIUY("EDT")_";H"
  1. . S TIUY("VLOC")=VLOC_U_$P($G(^SC(VLOC,0)),U)
  1. . S:'+$G(TIUY("LOC")) TIUY("LOC")=TIUY("VLOC")
  1. I $G(TIUVSTR)]"" S TIUY("VSTR")=TIUVSTR D VSIT(.TIUY,TIUVSTR)
  1. I '+$G(TIUMVN),'+$G(TIUVSTR) D CURRENT(.TIUY,DFN)
  1. ; D CURRENT(.TIUY,DFN)
  1. I +$$PROVIDER^TIUPXAP1($S($D(TIUAUTH):+$G(TIUAUTH),1:DUZ),+$G(TIUY("EDT"))) D
  1. . S TIUY("SVC")=$$PROVSVC(+$S($D(TIUAUTH):+$G(TIUAUTH),1:DUZ))
  1. I +$G(TIUY("VSTR")),(+$O(^TIU(8925,"AVSTRV",+DFN,$G(TIUY("VSTR")),0))>0) D
  1. . N TIUVSIT S TIUVSIT=+$O(^TIU(8925,"AVSTRV",+DFN,$G(TIUY("VSTR")),0))
  1. . I $P($G(^AUPNVSIT(+TIUVSIT,0)),U,5)'=DFN K ^TIU(8925,"AVSTRV",+DFN,$G(TIUY("VSTR")),TIUVSIT) Q
  1. . S TIUY("VISIT")=+TIUVSIT_U_+$G(^AUPNVSIT(+TIUVSIT,0))
  1. ; if pt an inpt + doc class is pn- default to current inpt loc
  1. S TIUTYPE=$S(+$P($G(TIUTYP(1)),U,2)>0:$P($G(TIUTYP(1)),U,2),1:+$G(TIUTYP))
  1. I +TIUTYPE'>0 S TIUY("INST")=$$DIVISION^TIULC1(+TIUY("LOC")) Q
  1. I +$G(TIUMVN),$D(^DPT(DFN,.1)),+$$ISPN^TIULX(TIUTYPE) D
  1. . I $D(VAIP(14,4)) S TIUY("LOC")=$G(^DIC(42,+VAIP(14,4),44))_U_$P(VAIP(14,4),U,2)
  1. S TIUY("INST")=$$DIVISION^TIULC1(+TIUY("LOC"))
  1. Q
  1. WARD(DA) ; Compute ward at discharge
  1. N %,D0,DIC,DIQ,DR,MOVE,X,Y
  1. I +DA'>0 S Y=$G(VAIP(TIUI,4)) G WARDX
  1. S DIC="^DGPM(",DIQ(0)="IE",DIQ="MOVE(",DR=200
  1. D EN^DIQ1
  1. S X=$G(MOVE(405,DA,200,"E")),DIC=42,DIC(0)="X" D ^DIC
  1. I +Y'>0 S Y=""
  1. WARDX Q Y
  1. PROVSVC(TIUSER) ; Resolve user's Service
  1. N TIUY
  1. S TIUY=$P($G(^VA(200,+TIUSER,5)),U)
  1. S:+TIUY TIUY=TIUY_U_$P(^DIC(49,+TIUY,0),U)
  1. Q TIUY
  1. VSIT(TIUY,TIUVSTR) ; Get Visit related info
  1. N DIC,DIQ,X,Y,DA,DR,VSIT,TIUCT,VAEL,VAERR
  1. D ELIG^VADPT
  1. I '$D(TIUY("EDT")) D
  1. . S TIUY("EDT")=$P(TIUVSTR,";",2)_U_$$DATE^TIULS($P(TIUVSTR,";",2),"AMTH DD, CCYY@HR:MIN")
  1. S TIUY("LDT")=$G(TIUY("LDT"))
  1. S TIUCT=$P(TIUVSTR,";",3)
  1. I TIUCT]"" S TIUY("CAT")=TIUCT_U_$S(TIUCT="A":"AMBULATORY",TIUCT="I":"IN HOSPITAL",TIUCT="H":"HOSPITALIZATION",TIUCT="T":"TELEPHONE",1:"EVENT (HISTORICAL)")
  1. I TIUCT="E",+$G(TIUVSTR)'>0 Q
  1. S TIUY("LVL")=$G(TIUY("LVL"))
  1. S TIUY("ELG")=$G(VAEL(1))
  1. S TIUY("VLOC")=+$G(TIUVSTR)_U_$P($G(^SC(+$G(TIUVSTR),0)),U)
  1. 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"))
  1. S:$P(TIUY("LOC"),U,2)']"" TIUY("LOC")=TIUY("LOC")_U_$P($G(^SC(+TIUY("LOC"),0)),U)
  1. I '$D(TIUY("DIV")),+$G(TIUY("LOC")) D
  1. . N TIUDIV,DIC,DR,DA,DIQ,X,Y
  1. . S DIC=44,DIQ="TIUDIV",DIQ(0)="IE",DA=+TIUY("LOC"),DR="3.5" D EN^DIQ1
  1. . I '+$G(TIUDIV(44,+DA,3.5,"I")) Q
  1. . S TIUY("DIV")=TIUDIV(44,+DA,3.5,"I")_U_TIUDIV(44,+DA,3.5,"E")
  1. I '$D(TIUY("DIV")),'+$G(TIUY("LOC")) D
  1. . S TIUY("DIV")=+$O(^DG(40.8,"AD",+$G(DUZ(2)),0))
  1. . S TIUY("DIV")=+TIUY("DIV")_U_$P($G(^DG(40.8,+$G(TIUY("DIV")),0)),U)
  1. S TIUY("INS")=$G(TIUY("DIV"))
  1. S TIUY("SC")=$G(TIUY("SC"))
  1. Q
  1. CURRENT(TIUY,DFN) ; Get current INPATIENT data
  1. N VAIN D INP^VADPT
  1. S TIUY("AD#")=$G(VAIN(1)),TIUY("PMD")=$G(VAIN(2))
  1. S TIUY("TS")=$G(VAIN(3)),TIUY("WARD")=$G(VAIN(4),"0^OUTPATIENT")
  1. S TIUY("RB")=$G(VAIN(5))
  1. I +TIUY("WARD") D
  1. . N DIC,DIQ,DR,DA,TIUDIV,Y
  1. . S DIC=42,DA=+TIUY("WARD"),DIQ="TIUDIV(",DIQ(0)="IE",DR=".015;44"
  1. . D EN^DIQ1
  1. . S TIUY("DIV")=$G(TIUDIV(42,DA,.015,"I"))_U_$G(TIUDIV(42,DA,.015,"E"))
  1. . S TIUY("LOC")=$G(TIUDIV(42,DA,44,"I"))_U_$G(TIUDIV(42,DA,44,"E"))
  1. S TIUY("LOC")=$G(TIUY("LOC"))
  1. I '+$G(TIUY("DIV")) D
  1. . N DIC,DIQ,DR,DA
  1. . S DIC=4,DR=".01",DA=+$G(DUZ(2)),DIQ="TIUDIV1"
  1. . D EN^DIQ1
  1. . ;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))
  1. . S TIUY("DIV")=+$G(DUZ(2))_U_+$G(TIUDIV1(4,+$G(DUZ(2)),.01))
  1. Q