source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULV.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.8 KB
RevLine 
[613]1TIULV ; SLC/JER - Visit/Movement related library ; 4/18/03
2 ;;1.0;TEXT INTEGRATION UTILITIES;**7,30,55,45,52,148,156,152,113,200**;Jun 20, 1997
3PATPN(TIUY,DFN) ; Get minimum demographics for PN Print
4 N VADM,VAIP,VAIN,VA,VAPA
5 D OERR^VADPT
6 S TIUY("PNMP")=$E($G(VADM(1)),1,30)
7 S TIUY("SSN")=$G(VA("PID"))
8 S TIUY("DOB")="DOB:"_$$DATE^TIULS(+$G(VADM(3)),"MM/DD/CCYY")
9 D ADD^VADPT
10 I $G(VAPA(8))'="" S TIUY("PH#")="Ph:"_VAPA(8)
11 I $G(VAPA(8))="" S TIUY("PH#")="Ph: **UNKNOWN**"
12 S TIUY("INTNM")=$$NAME^VASITE ;Integration Name
13 S TIUY("SITE")=$P($$SITE^VASITE,U,2)
14 S TIUY("LOCP")="Pt Loc: "_$S(VAIN(4)]"":$P(VAIN(4),U,2)_" "_VAIN(5),1:"OUTPATIENT")
15 Q
16 ;
17PATVADPT(TIUY,DFN,TIUMVN,TIUVSTR,TIUSDC) ; Extract MAS data
18 N VA,VADM,VAEL,VAERR,VAIP,TIUI,TIUWARD,X,Y,TIUTYPE,TIUFTS,TIUSS,VAPA
19 D DEM^VADPT
20 S TIUY("PNM")=$G(VADM(1)),TIUY("SSN")=$G(VA("PID"))
21 S TIUY("AGE")=$G(VADM(4)),TIUY("PID")="("_$E(TIUY("PNM"))_VA("BID")_")"
22 S TIUY("DOB")=$G(VADM(3))
23 D ADD^VADPT
24 I $G(VAPA(8))'="" S TIUY("PH#")=VAPA(8)
25 I $G(VAPA(8))="" S TIUY("PH#")="**UNKNOWN**"
26 S TIUY("SEX")=$G(VADM(5))
27 ; Below TIU*148
28 I +$G(VADM(12))>0 D
29 . F TIUY("NUMRACE")=1:1:VADM(12) S TIUY("RACE",TIUY("NUMRACE"))=$G(VADM(12,TIUY("NUMRACE")))
30 S TIUY("RACENO")=+$G(VADM(12))
31 I +$G(VADM(12))=0 S TIUY("RACE")=$G(VADM(8))
32 I +$G(TIUSDC) S TIUY("STOP")=$G(TIUSDC)
33 I +$G(TIUD13(0)) S TIUY("REFDT")=+$G(TIUD13(0))
34 I +$G(TIUMVN),$D(^DGPM(+TIUMVN)) D
35 . ; N VLOC,VDT,TIUDIV
36 . N VLOC,VDT,TIUDIV
37 . S VAIP("E")=TIUMVN D 52^VADPT
38 . S TIUI=$S(+$G(VAIP(17,1)):17,1:14)
39 . S TIUY("CLAIM")=$G(VAEL(7)),TIUY("PMD")=$G(VAIP(TIUI,5))
40 . S TIUY("AMD")=$G(VAIP(18)),TIUY("TS")=$G(VAIP(TIUI,6))
41 . S TIUY("SVC")=+$$GET1^DIQ(45.7,+TIUY("TS"),2,"I",,"ERROR")
42 . S TIUY("SVC")=TIUY("SVC")_U_$$GET1^DIQ(49,+TIUY("SVC"),.01,"I",,"ERROR")
43 . S TIUY("WARD")=$$WARD($G(VAIP(17)))
44 . S (TIUY("ADDT"),TIUY("EDT"))=$G(VAIP(3))
45 . I +TIUY("WARD") S TIUY("LOC")=$G(^DIC(42,+TIUY("WARD"),44))
46 . I +$G(TIUY("LOC")) D
47 . . S TIUY("LOC")=TIUY("LOC")_U_$P($G(^SC(+TIUY("LOC"),0)),U)
48 . S TIUY("ADDX")=$G(VAIP(9)),TIUY("LDT")=$G(VAIP(17,1))
49 . S TIUY("AD#")=+$G(VAIP(13)),TIUY("MTYPE")=$G(VAIP(TIUI,3))
50 . S TIUDIV=$P($G(^DIC(42,+TIUY("WARD"),0)),U,11)
51 . I +TIUDIV S TIUY("DIV")=TIUDIV_U_$P($G(^DG(40.8,+TIUDIV,0)),U)
52 . S VDT=+VAIP(3)
53 . S VLOC=$G(^DIC(42,+$P($G(VAIP(13,4)),U),44))
54 . S TIUY("VSTR")=VLOC_";"_+TIUY("EDT")_";H"
55 . S TIUY("VLOC")=VLOC_U_$P($G(^SC(VLOC,0)),U)
56 . S:'+$G(TIUY("LOC")) TIUY("LOC")=TIUY("VLOC")
57 I $G(TIUVSTR)]"" S TIUY("VSTR")=TIUVSTR D VSIT(.TIUY,TIUVSTR)
58 I '+$G(TIUMVN),'+$G(TIUVSTR) D CURRENT(.TIUY,DFN)
59 ; D CURRENT(.TIUY,DFN)
60 I +$$PROVIDER^TIUPXAP1($S($D(TIUAUTH):+$G(TIUAUTH),1:DUZ),+$G(TIUY("EDT"))) D
61 . S TIUY("SVC")=$$PROVSVC(+$S($D(TIUAUTH):+$G(TIUAUTH),1:DUZ))
62 I +$G(TIUY("VSTR")),(+$O(^TIU(8925,"AVSTRV",+DFN,$G(TIUY("VSTR")),0))>0) D
63 . N TIUVSIT S TIUVSIT=+$O(^TIU(8925,"AVSTRV",+DFN,$G(TIUY("VSTR")),0))
64 . I $P($G(^AUPNVSIT(+TIUVSIT,0)),U,5)'=DFN K ^TIU(8925,"AVSTRV",+DFN,$G(TIUY("VSTR")),TIUVSIT) Q
65 . S TIUY("VISIT")=+TIUVSIT_U_+$G(^AUPNVSIT(+TIUVSIT,0))
66 ; if pt an inpt + doc class is pn- default to current inpt loc
67 S TIUTYPE=$S(+$P($G(TIUTYP(1)),U,2)>0:$P($G(TIUTYP(1)),U,2),1:+$G(TIUTYP))
68 I +TIUTYPE'>0 S TIUY("INST")=$$DIVISION^TIULC1(+TIUY("LOC")) Q
69 I +$G(TIUMVN),$D(^DPT(DFN,.1)),+$$ISPN^TIULX(TIUTYPE) D
70 . I $D(VAIP(14,4)) S TIUY("LOC")=$G(^DIC(42,+VAIP(14,4),44))_U_$P(VAIP(14,4),U,2)
71 S TIUY("INST")=$$DIVISION^TIULC1(+TIUY("LOC"))
72 Q
73WARD(DA) ; Compute ward at discharge
74 N %,D0,DIC,DIQ,DR,MOVE,X,Y
75 I +DA'>0 S Y=$G(VAIP(TIUI,4)) G WARDX
76 S DIC="^DGPM(",DIQ(0)="IE",DIQ="MOVE(",DR=200
77 D EN^DIQ1
78 S X=$G(MOVE(405,DA,200,"E")),DIC=42,DIC(0)="X" D ^DIC
79 I +Y'>0 S Y=""
80WARDX Q Y
81PROVSVC(TIUSER) ; Resolve user's Service
82 N TIUY
83 S TIUY=$P($G(^VA(200,+TIUSER,5)),U)
84 S:+TIUY TIUY=TIUY_U_$P(^DIC(49,+TIUY,0),U)
85 Q TIUY
86VSIT(TIUY,TIUVSTR) ; Get Visit related info
87 N DIC,DIQ,X,Y,DA,DR,VSIT,TIUCT,VAEL,VAERR
88 D ELIG^VADPT
89 I '$D(TIUY("EDT")) D
90 . S TIUY("EDT")=$P(TIUVSTR,";",2)_U_$$DATE^TIULS($P(TIUVSTR,";",2),"AMTH DD, CCYY@HR:MIN")
91 S TIUY("LDT")=$G(TIUY("LDT"))
92 S TIUCT=$P(TIUVSTR,";",3)
93 I TIUCT]"" S TIUY("CAT")=TIUCT_U_$S(TIUCT="A":"AMBULATORY",TIUCT="I":"IN HOSPITAL",TIUCT="H":"HOSPITALIZATION",TIUCT="T":"TELEPHONE",1:"EVENT (HISTORICAL)")
94 I TIUCT="E",+$G(TIUVSTR)'>0 Q
95 S TIUY("LVL")=$G(TIUY("LVL"))
96 S TIUY("ELG")=$G(VAEL(1))
97 S TIUY("VLOC")=+$G(TIUVSTR)_U_$P($G(^SC(+$G(TIUVSTR),0)),U)
98 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"))
99 S:$P(TIUY("LOC"),U,2)']"" TIUY("LOC")=TIUY("LOC")_U_$P($G(^SC(+TIUY("LOC"),0)),U)
100 I '$D(TIUY("DIV")),+$G(TIUY("LOC")) D
101 . N TIUDIV,DIC,DR,DA,DIQ,X,Y
102 . S DIC=44,DIQ="TIUDIV",DIQ(0)="IE",DA=+TIUY("LOC"),DR="3.5" D EN^DIQ1
103 . I '+$G(TIUDIV(44,+DA,3.5,"I")) Q
104 . S TIUY("DIV")=TIUDIV(44,+DA,3.5,"I")_U_TIUDIV(44,+DA,3.5,"E")
105 I '$D(TIUY("DIV")),'+$G(TIUY("LOC")) D
106 . S TIUY("DIV")=+$O(^DG(40.8,"AD",+$G(DUZ(2)),0))
107 . S TIUY("DIV")=+TIUY("DIV")_U_$P($G(^DG(40.8,+$G(TIUY("DIV")),0)),U)
108 S TIUY("INS")=$G(TIUY("DIV"))
109 S TIUY("SC")=$G(TIUY("SC"))
110 Q
111CURRENT(TIUY,DFN) ; Get current INPATIENT data
112 N VAIN D INP^VADPT
113 S TIUY("AD#")=$G(VAIN(1)),TIUY("PMD")=$G(VAIN(2))
114 S TIUY("TS")=$G(VAIN(3)),TIUY("WARD")=$G(VAIN(4),"0^OUTPATIENT")
115 S TIUY("RB")=$G(VAIN(5))
116 I +TIUY("WARD") D
117 . N DIC,DIQ,DR,DA,TIUDIV,Y
118 . S DIC=42,DA=+TIUY("WARD"),DIQ="TIUDIV(",DIQ(0)="IE",DR=".015;44"
119 . D EN^DIQ1
120 . S TIUY("DIV")=$G(TIUDIV(42,DA,.015,"I"))_U_$G(TIUDIV(42,DA,.015,"E"))
121 . S TIUY("LOC")=$G(TIUDIV(42,DA,44,"I"))_U_$G(TIUDIV(42,DA,44,"E"))
122 S TIUY("LOC")=$G(TIUY("LOC"))
123 I '+$G(TIUY("DIV")) D
124 . N DIC,DIQ,DR,DA
125 . S DIC=4,DR=".01",DA=+$G(DUZ(2)),DIQ="TIUDIV1"
126 . D EN^DIQ1
127 . ;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))
128 . S TIUY("DIV")=+$G(DUZ(2))_U_+$G(TIUDIV1(4,+$G(DUZ(2)),.01))
129 Q
Note: See TracBrowser for help on using the repository browser.