source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VADPT30.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1VADPT30 ;ALB/MJK - Current Inpatient Variables; 12 DEC 1988 ; 5/5/05 11:41am
2 ;;5.3;Registration;**111,498,509,662**;Aug 13, 1993
3 ;
4VAR ; -- inpatient demographics variables
5 ; input: DFN, VATD = inverse date ; VACN =
6 ; VAPRC = ; VAPRT =
7 ;
8 ; output: VAWD = ward ; VATS = tr. spec. ; VARM = room/bed
9 ; VAPP = doc ; VADX = diagnosis ; VAMV = mv entry
10 ; VAAP = attending physician
11 ; VAFD = answer to facility directory question
12 ;
13 S (VAWDA,VAWD,VATS,VAMV,VARM,VAPP,VAAP,VADX,VAFD)="",VAID=VATD
14 ; -- get mv
15 D MV G VARQ:VAMV0']""
16 S Y=$G(^DGPM(+$P(VAMV0,"^",14),0)) I $P(Y,"^",2)=1 D
17 .N DCD
18 .S DCD=+$P(Y,"^",17) I DCD S DCD=+$G(^DGPM(DCD,0))
19 .S Y=$G(^DGPM(+$P(VAMV0,"^",14),"DIR"))
20 .S Y=$P(Y,"^",1)
21 .I Y="" S Y=$S('DCD:1,(DCD<3030414.999999):"",1:1) Q:Y=""
22 .S VAFD=Y_"^"_$$EXTERNAL^DILFD(405,41,,Y)
23 ; quit if not an adm or xfr
24 I "^1^2^"'[("^"_$P(VAMV0,"^",2)_"^") G VARQ
25 I 'VAPRC,"^2^3^13^25^26^43^44^45^"[("^"_VAMT_"^") G VARQ
26 I VAPRC,"^13^43^44^45^"[("^"_VAMT_"^") G VARQ
27 S:VAPRC VABO=$S(VAMT<4:VAMT,1:4) D GET
28 ;I 'VACN,'VATS S VATS=TSD ;what is this
29VARQ K VAMV0,VAMT,VAID
30 Q
31 ;
32GET ; -- get variables and quit when all set(Y=1)
33 S VACA=+$P(VAMV0,"^",14)
34 N VAT
35 D TS,SET G GETQ:Y
36 F VAID=VATD:0 S VAID=$O(^DGPM("APMV",DFN,VACA,VAID)) Q:'VAID F VAIFN=0:0 S VAIFN=$O(^DGPM("APMV",DFN,VACA,VAID,VAIFN)) Q:'VAIFN I $D(^DGPM(VAIFN,0)) S VAMV0=^(0) D SET G GETQ:Y
37GETQ K VACA,VAIFN,VAID Q
38 ;
39KVAR K VAMV,VAWDA,VAWD,VARM,VAPP,VAAP,VATS,VATD,VAPRC,VAPRT,VACN,VADX,VABO,VAFD Q
40 ;
41SET ; -- set variables if null
42 S Y=0
43 I 'VAWD,$D(^DIC(42,+$P(VAMV0,"^",6),0)) S VAWDA=$S($D(VAIFN):VAIFN,1:VAMV),VAWD=$P(VAMV0,"^",6)_"^"_$P(^(0),"^") S VARM="" I $D(^DG(405.4,+$P(VAMV0,"^",7),0)) S VARM=$P(VAMV0,"^",7)_"^"_$P(^(0),"^")
44 I 'VACN,VAWD S Y=1
45 N VARSTR
46 S VARSTR="^^^^^VAWD^VARM^VAPP^VATS^VADX^^^^^^^^^VAAP^"
47 S $P(VARSTR,"^",41)="VAFD"
48 I VACN,'VAPRT,$D(DGPMDDF),@$P(VARSTR,"^",+DGPMDDF),VAMV S Y=1
49 I VACN,VAPRT,VAWD,VAMV,VADX]"" S Y=1
50 Q
51 ;
52TS ; set VADX, VATS, VAAP, and VAPP via VACA x-refs
53 N VAMV0
54 S:$D(^DGPM(VACA,0)) VADX=$P(^(0),"^",10)
55 F VAID=VATD:0 S VAID=$O(^DGPM("ATS",DFN,VACA,VAID)) Q:'VAID F VAT=0:0 S VAT=$O(^DGPM("ATS",DFN,VACA,VAID,VAT)) Q:'VAT F VAIFN=0:0 S VAIFN=$O(^DGPM("ATS",DFN,VACA,VAID,VAT,VAIFN)) Q:'VAIFN D TS1 G TSQ:VAPP&VATS&VAAP
56TSQ K VAIFN,VAT Q
57 ;
58TS1 ; set VATS, VAPP, and VAAP
59 Q:'$D(^DGPM(VAIFN,0)) S VAMV0=^(0)
60 I 'VAPP,$D(^VA(200,+$P(VAMV0,"^",8),0)) S Y=$P(VAMV0,"^",8)_"^"_$P(^(0),"^") S VAPP=Y
61 I 'VAAP,$D(^VA(200,+$P(VAMV0,"^",19),0)) S Y=$P(VAMV0,"^",19)_"^"_$P(^(0),"^") S VAAP=Y
62 I 'VATS,$D(^DIC(45.7,+$P(VAMV0,"^",9),0)) S VATS=$P(VAMV0,"^",9)_"^"_$P(^(0),"^")
63 Q
64 ;
65MV ; -- get latest mv for pt before VAID and not ASIH mv
66 S (VAMV,VAMV0)=""
67 F VAID=VAID:0 S VAID=$O(^DGPM("APID",DFN,VAID)) G MVQ:'VAID S VAMV=$O(^DGPM("APID",DFN,VAID,0)) I $D(^DGPM(+VAMV,0)) S VAMT=$P(^(0),"^",18) G MVQ:'VAMT Q:"^13^41^42^47^"'[("^"_VAMT_"^")
68 S VAMV0=^DGPM(VAMV,0)
69MVQ Q
70 ;
71A ;return current admission or last admission for patient
72 S Y=$S($D(^DPT(DFN,.105)):+^(.105),1:0) G AQ:$D(^DGPM(Y,0))
73 N VAID,VAMV,VAMV0
74 F VAID=0:0 S VAID=$O(^DGPM("ATID1",DFN,VAID)) Q:'VAID F VAMV=0:0 S VAMV=$O(^DGPM("ATID1",DFN,VAID,VAMV)) Q:'VAMV I $D(^DGPM(VAMV,0)) S VAMV0=^(0) D DIS G AQ:Y
75 S Y=0
76AQ Q
77 ;
78DIS ; check for ASIH discharges
79 S Y=$S('$D(^DGPM(+$P(VAMV0,"^",17),0)):VAMV,"^41^46"[(U_$P(^(0),"^",18)_U):0,1:VAMV)
80 Q
81 ;
Note: See TracBrowser for help on using the repository browser.