BLRDPT30 ; IHS/DIR/FJE - Current Inpatient Variables ;
;;5.2;BLR;;NOV 01, 1997
;
;;MAS VERSION 5.0;
;
VAR ; -- inpatient demographics variables
; input: DFN, VATD = inverse date ; VACN =
; VAPRC = ; VAPRT =
;
; output: VAWD = ward ; VATS = tr. spec. ; VARM = room/bed
; VAPP = doc ; VADX = diagnosis ; VAMV = mv entry
;
S (VAWDA,VAWD,VATS,VAMV,VARM,VAPP,VADX)="",VAID=VATD
; -- get mv
D MV G VARQ:VAMV0']""
; quit if not an adm or xfr
I "^1^2^"'[("^"_$P(VAMV0,"^",2)_"^") G VARQ
I 'VAPRC,"^2^3^13^25^26^43^44^45^"[("^"_VAMT_"^") G VARQ
I VAPRC,"^13^43^44^45^"[("^"_VAMT_"^") G VARQ
S:VAPRC VABO=$S(VAMT<4:VAMT,1:4) D GET
;I 'VACN,'VATS S VATS=TSD ;what is this
VARQ K VAMV0,VAMT,VAID
Q
;
GET ; -- get variables and quit when all set(Y=1)
S VACA=+$P(VAMV0,"^",14)
D TS,SET G GETQ:Y
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
GETQ K VACA,VAIFN,VAID Q
;
KVAR K VAMV,VAWDA,VAWD,VARM,VAPP,VATS,VATD,VAPRC,VAPRT,VACN,VADX,VABO Q
;
SET ; -- set variables if null
S Y=0
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),"^")
I 'VACN,VAWD S Y=1
I VACN,'VAPRT,$D(DGPMDDF),@$P("^^^^^VAWD^VARM^VAPP^VATS^VADX^","^",+DGPMDDF),VAMV S Y=1
I VACN,VAPRT,VAWD,VAMV,VADX]"" S Y=1
Q
;
TS ; set VADX, VATS and VAPP via VACA x-refs
N VAMV0
S:$D(^DGPM(VACA,0)) VADX=$P(^(0),"^",10)
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
TSQ K VAIFN,VAT Q
;
TS1 ; set VATS and VAPP
Q:'$D(^DGPM(VAIFN,0)) S VAMV0=^(0)
;I 'VAPP,$D(^DIC(16,+$P(VAMV0,"^",8),0)) S Y=$P(VAMV0,"^",8)_"^"_$P(^(0),"^") D PROV:$D(VA200) S VAPP=Y ;IHS/ANMC/LJF 5/9/96 not needed
I 'VAPP,$D(^VA(200,+$P(VAMV0,U,8),0)) S Y=$P(VAMV0,U,8),VAPP=Y_U_$P(^VA(200,Y,0),U) ;IHS/ANMC/LJF 5/9/96 ADT v5 converted to file 200
I 'VATS,$D(^DIC(45.7,+$P(VAMV0,"^",9),0)) S VATS=$P(VAMV0,"^",9)_"^"_$P(^(0),"^")
Q
;
MV ; -- get latest mv for pt before VAID and not ASIH mv
S (VAMV,VAMV0)=""
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_"^")
S VAMV0=^DGPM(VAMV,0)
MVQ Q
;
A ;return current admission or last admission for patient
S Y=$S($D(^DPT(DFN,.105)):+^(.105),1:0) G AQ:$D(^DGPM(Y,0))
N VAID,VAMV,VAMV0
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
S Y=0
AQ Q
;
DIS ; check for ASIH discharges
S Y=$S('$D(^DGPM(+$P(VAMV0,"^",17),0)):VAMV,"^41^46"[(U_$P(^(0),"^",18)_U):0,1:VAMV)
Q
;
PROV ; -- get provider info
S X=+Y,Y="^"
I $D(^DIC(16,X,"A3")) S X=+^("A3") I $D(^VA(200,X,0)) S Y=X_"^"_$P(^(0),"^")
;I $D(^DIC(3,X,0)) S X=+$P(^(0),"^",16) I $D(^DIC(16,X,0)) S Y=X_"^"_$P(^(0),"^")
K X Q
BLRDPT30 ; IHS/DIR/FJE - Current Inpatient Variables ;
+1 ;;5.2;BLR;;NOV 01, 1997
+2 ;
+3 ;;MAS VERSION 5.0;
+4 ;
VAR ; -- inpatient demographics variables
+1 ; input: DFN, VATD = inverse date ; VACN =
+2 ; VAPRC = ; VAPRT =
+3 ;
+4 ; output: VAWD = ward ; VATS = tr. spec. ; VARM = room/bed
+5 ; VAPP = doc ; VADX = diagnosis ; VAMV = mv entry
+6 ;
+7 SET (VAWDA,VAWD,VATS,VAMV,VARM,VAPP,VADX)=""
SET VAID=VATD
+8 ; -- get mv
+9 DO MV
IF VAMV0']""
GOTO VARQ
+10 ; quit if not an adm or xfr
+11 IF "^1^2^"'[("^"_$PIECE(VAMV0,"^",2)_"^")
GOTO VARQ
+12 IF 'VAPRC
IF "^2^3^13^25^26^43^44^45^"[("^"_VAMT_"^")
GOTO VARQ
+13 IF VAPRC
IF "^13^43^44^45^"[("^"_VAMT_"^")
GOTO VARQ
+14 IF VAPRC
SET VABO=$SELECT(VAMT<4:VAMT,1:4)
DO GET
+15 ;I 'VACN,'VATS S VATS=TSD ;what is this
VARQ KILL VAMV0,VAMT,VAID
+1 QUIT
+2 ;
GET ; -- get variables and quit when all set(Y=1)
+1 SET VACA=+$PIECE(VAMV0,"^",14)
+2 DO TS
DO SET
IF Y
GOTO GETQ
+3 FOR VAID=VATD:0
SET VAID=$ORDER(^DGPM("APMV",DFN,VACA,VAID))
IF 'VAID
QUIT
FOR VAIFN=0:0
SET VAIFN=$ORDER(^DGPM("APMV",DFN,VACA,VAID,VAIFN))
IF 'VAIFN
QUIT
IF $DATA(^DGPM(VAIFN,0))
SET VAMV0=^(0)
DO SET
IF Y
GOTO GETQ
GETQ KILL VACA,VAIFN,VAID
QUIT
+1 ;
KVAR KILL VAMV,VAWDA,VAWD,VARM,VAPP,VATS,VATD,VAPRC,VAPRT,VACN,VADX,VABO
QUIT
+1 ;
SET ; -- set variables if null
+1 SET Y=0
+2 IF 'VAWD
IF $DATA(^DIC(42,+$PIECE(VAMV0,"^",6),0))
SET VAWDA=$SELECT($DATA(VAIFN):VAIFN,1:VAMV)
SET VAWD=$PIECE(VAMV0,"^",6)_"^"_$PIECE(^(0),"^")
SET VARM=""
IF $DATA(^DG(405.4,+$PIECE(VAMV0,"^",7),0))
SET VARM=$PIECE(VAMV0,"^",7)_"^"_$PIECE(^(0),"^")
+3 IF 'VACN
IF VAWD
SET Y=1
+4 IF VACN
IF 'VAPRT
IF $DATA(DGPMDDF)
IF @$PIECE("^^^^^VAWD^VARM^VAPP^VATS^VADX^","^",+DGPMDDF)
IF VAMV
SET Y=1
+5 IF VACN
IF VAPRT
IF VAWD
IF VAMV
IF VADX]""
SET Y=1
+6 QUIT
+7 ;
TS ; set VADX, VATS and VAPP via VACA x-refs
+1 NEW VAMV0
+2 IF $DATA(^DGPM(VACA,0))
SET VADX=$PIECE(^(0),"^",10)
+3 FOR VAID=VATD:0
SET VAID=$ORDER(^DGPM("ATS",DFN,VACA,VAID))
IF 'VAID
QUIT
FOR VAT=0:0
SET VAT=$ORDER(^DGPM("ATS",DFN,VACA,VAID,VAT))
IF 'VAT
QUIT
FOR VAIFN=0:0
SET VAIFN=$ORDER(^DGPM("ATS",DFN,VACA,VAID,VAT,VAIFN))
IF 'VAIFN
QUIT
DO TS1
IF VAPP&VATS
GOTO TSQ
TSQ KILL VAIFN,VAT
QUIT
+1 ;
TS1 ; set VATS and VAPP
+1 IF '$DATA(^DGPM(VAIFN,0))
QUIT
SET VAMV0=^(0)
+2 ;I 'VAPP,$D(^DIC(16,+$P(VAMV0,"^",8),0)) S Y=$P(VAMV0,"^",8)_"^"_$P(^(0),"^") D PROV:$D(VA200) S VAPP=Y ;IHS/ANMC/LJF 5/9/96 not needed
+3 ;IHS/ANMC/LJF 5/9/96 ADT v5 converted to file 200
IF 'VAPP
IF $DATA(^VA(200,+$PIECE(VAMV0,U,8),0))
SET Y=$PIECE(VAMV0,U,8)
SET VAPP=Y_U_$PIECE(^VA(200,Y,0),U)
+4 IF 'VATS
IF $DATA(^DIC(45.7,+$PIECE(VAMV0,"^",9),0))
SET VATS=$PIECE(VAMV0,"^",9)_"^"_$PIECE(^(0),"^")
+5 QUIT
+6 ;
MV ; -- get latest mv for pt before VAID and not ASIH mv
+1 SET (VAMV,VAMV0)=""
+2 FOR VAID=VAID:0
SET VAID=$ORDER(^DGPM("APID",DFN,VAID))
IF 'VAID
GOTO MVQ
SET VAMV=$ORDER(^DGPM("APID",DFN,VAID,0))
IF $DATA(^DGPM(+VAMV,0))
SET VAMT=$PIECE(^(0),"^",18)
IF 'VAMT
GOTO MVQ
IF "^13^41^42^47^"'[("^"_VAMT_"^")
QUIT
+3 SET VAMV0=^DGPM(VAMV,0)
MVQ QUIT
+1 ;
A ;return current admission or last admission for patient
+1 SET Y=$SELECT($DATA(^DPT(DFN,.105)):+^(.105),1:0)
IF $DATA(^DGPM(Y,0))
GOTO AQ
+2 NEW VAID,VAMV,VAMV0
+3 FOR VAID=0:0
SET VAID=$ORDER(^DGPM("ATID1",DFN,VAID))
IF 'VAID
QUIT
FOR VAMV=0:0
SET VAMV=$ORDER(^DGPM("ATID1",DFN,VAID,VAMV))
IF 'VAMV
QUIT
IF $DATA(^DGPM(VAMV,0))
SET VAMV0=^(0)
DO DIS
IF Y
GOTO AQ
+4 SET Y=0
AQ QUIT
+1 ;
DIS ; check for ASIH discharges
+1 SET Y=$SELECT('$DATA(^DGPM(+$PIECE(VAMV0,"^",17),0)):VAMV,"^41^46"[(U_$PIECE(^(0),"^",18)_U):0,1:VAMV)
+2 QUIT
+3 ;
PROV ; -- get provider info
+1 SET X=+Y
SET Y="^"
+2 IF $DATA(^DIC(16,X,"A3"))
SET X=+^("A3")
IF $DATA(^VA(200,X,0))
SET Y=X_"^"_$PIECE(^(0),"^")
+3 ;I $D(^DIC(3,X,0)) S X=+$P(^(0),"^",16) I $D(^DIC(16,X,0)) S Y=X_"^"_$P(^(0),"^")
+4 KILL X
QUIT
