BLRDPT ; IHS/DIR/FJE - RETURN PATIENT VARIABLE ARRAYS ; [ 04/07/1999 9:05 AM ]
;;5.2;BLR;**1008**;NOV 01, 1997
;
;;MAS VERSION 5.0;
;DFN = Patient IFN [if not passed entire array returned as null]
;
DEM ;Demographic Variables
;S VAN=1,VAN(1)=10,VAV="VADM" D ^BLRDPT0 Q
S VAN=1,VAN(1)=11,VAV="VADM" D ^BLRDPT0 Q ;IHS/ANMC/CLS 10/15/94
;
OPD ;Other Patient Data
S VAN=2,VAN(1)=7,VAV="VAPD" D ^BLRDPT0 Q
;
ADD ;Current Address
S VAN=3,VAN(1)=10,VAV="VAPA" D ^BLRDPT0 Q
;
OAD ;Other Patient Variables
S VAN=4,VAN(1)=10,VAV="VAOA" D ^BLRDPT0 Q
;
INP ;Inpatient Data [pre-version 5]
S VAN=5,VAN(1)=10,VAV="VAIN" D ^BLRDPT0 Q
;
IN5 ;Inpatient Data [v5.0 and above]
S VAN=6,VAN(1)=17,VAV=$S('$D(VAIP("V")):"VAIP",VAIP("V")'?1A.E:"VAIP",1:VAIP("V")) D ^BLRDPT0 Q
;
ELIG ;Eligibility Information
S VAN=7,VAN(1)=9,VAV="VAEL" D ^BLRDPT0 Q
;
MB ;Monetary Benefits
S VAN=8,VAN(1)=9,VAV="VAMB" D ^BLRDPT0 Q
;
SVC ;Service Information
S VAN=9,VAN(1)=8,VAV="VASV" D ^BLRDPT0 Q
;
REG ;Registration data
S VAN=10,VAV="VARP" D ^BLRDPT0 Q
;
SDE ;Enrollment Information
S VAN=11,VAV="VAEN" D ^BLRDPT0 Q
;
SDA ;Appointment Information
S VAN=12,VAV="VASD" D ^BLRDPT0 Q
;
PID ;Patient Id
S VAN=13,VAV="VA" D ^BLRDPT0 Q
;
V5 S X=$S($D(^DG(43,1,"VERSION")):+^("VERSION"),1:""),VADPT("V")=$S(X<5:0,1:1) K X Q
OERR ;
1 S VATAG=1 D MULT Q
2 S VATAG=2 D MULT Q
3 S VATAG=3 D MULT Q
4 S VATAG=4 D MULT Q
5 S VATAG=5 D MULT Q
6 S VATAG=6 D MULT Q
7 S VATAG=7 D MULT Q
8 S VATAG=8 D MULT Q
9 S VATAG=9 D MULT Q
10 S VATAG=10 D MULT Q
51 S VATAG=11 D MULT Q
52 S VATAG=12 D MULT Q
53 S VATAG=13 D MULT Q
ALL S VATAG=14 D MULT Q
A5 S VATAG=15 D MULT Q
SEL Q:$O(VARRAY(0))']"" S VATAG=0,VATAG(2)=$P($T(TAG),";;",2)
F VATAG(1)=0:0 S VATAG=$O(VARRAY(VATAG)) Q:VATAG="" I VATAG(2)[("^"_VATAG_"^") S VARRAY(VATAG)=1,VAROOT=$S($D(VAROOT(VATAG)):VAROOT(VATAG),1:"") D @VATAG
G Q
;
MULT S VATAG=$P($T(TG+VATAG),";;",2)
F VATAG(1)=1:1 S VATAG(2)=$P(VATAG,"^",VATAG(1)) Q:VATAG(2)="" S VAROOT=$S($D(VAROOT(VATAG(2))):VAROOT(VATAG(2)),1:"") D @(VATAG(2))
Q S VAROOT="" K VATAG Q
;
KVA K VA
KVAR D JOB^BLRPARAM,KVAR^BLRDPT0 K:$D(VAIP("V")) @(VAIP("V")) K I,X,Y,VARRAY,VADM,VAPD,VADPT,VAOA,VASV,VAEL,VAMB,VARP,VAEN,VASD,VAIN,VAIP,VAPA,VAHOW,VAINDT,VAERR,^UTILITY("VADPT",$J),VA200,VATEST Q
;
TG ;
;;DEM^INP
;;DEM^ELIG
;;ELIG^INP
;;DEM^ADD
;;ADD^INP
;;DEM^ELIG^ADD
;;ELIG^SVC
;;ELIG^SVC^MB
;;DEM^REG^SDE^SDA
;;SDE^SDA
;;DEM^IN5
;;ELIG^IN5
;;ADD^IN5
;;DEM^OPD^INP^ADD^ELIG^SVC^OAD^MB^REG^SDE^SDA
;;DEM^OPD^IN5^ADD^ELIG^SVC^OAD^MB^REG^SDE^SDA
;
TAG ;;^DEM^OPD^INP^IN5^ADD^OAD^ELIG^SVC^MB^REG^SDE^SDA^
BLRDPT ; IHS/DIR/FJE - RETURN PATIENT VARIABLE ARRAYS ; [ 04/07/1999 9:05 AM ]
+1 ;;5.2;BLR;**1008**;NOV 01, 1997
+2 ;
+3 ;;MAS VERSION 5.0;
+4 ;DFN = Patient IFN [if not passed entire array returned as null]
+5 ;
DEM ;Demographic Variables
+1 ;S VAN=1,VAN(1)=10,VAV="VADM" D ^BLRDPT0 Q
+2 ;IHS/ANMC/CLS 10/15/94
SET VAN=1
SET VAN(1)=11
SET VAV="VADM"
DO ^BLRDPT0
QUIT
+3 ;
OPD ;Other Patient Data
+1 SET VAN=2
SET VAN(1)=7
SET VAV="VAPD"
DO ^BLRDPT0
QUIT
+2 ;
ADD ;Current Address
+1 SET VAN=3
SET VAN(1)=10
SET VAV="VAPA"
DO ^BLRDPT0
QUIT
+2 ;
OAD ;Other Patient Variables
+1 SET VAN=4
SET VAN(1)=10
SET VAV="VAOA"
DO ^BLRDPT0
QUIT
+2 ;
INP ;Inpatient Data [pre-version 5]
+1 SET VAN=5
SET VAN(1)=10
SET VAV="VAIN"
DO ^BLRDPT0
QUIT
+2 ;
IN5 ;Inpatient Data [v5.0 and above]
+1 SET VAN=6
SET VAN(1)=17
SET VAV=$SELECT('$DATA(VAIP("V")):"VAIP",VAIP("V")'?1A.E:"VAIP",1:VAIP("V"))
DO ^BLRDPT0
QUIT
+2 ;
ELIG ;Eligibility Information
+1 SET VAN=7
SET VAN(1)=9
SET VAV="VAEL"
DO ^BLRDPT0
QUIT
+2 ;
MB ;Monetary Benefits
+1 SET VAN=8
SET VAN(1)=9
SET VAV="VAMB"
DO ^BLRDPT0
QUIT
+2 ;
SVC ;Service Information
+1 SET VAN=9
SET VAN(1)=8
SET VAV="VASV"
DO ^BLRDPT0
QUIT
+2 ;
REG ;Registration data
+1 SET VAN=10
SET VAV="VARP"
DO ^BLRDPT0
QUIT
+2 ;
SDE ;Enrollment Information
+1 SET VAN=11
SET VAV="VAEN"
DO ^BLRDPT0
QUIT
+2 ;
SDA ;Appointment Information
+1 SET VAN=12
SET VAV="VASD"
DO ^BLRDPT0
QUIT
+2 ;
PID ;Patient Id
+1 SET VAN=13
SET VAV="VA"
DO ^BLRDPT0
QUIT
+2 ;
V5 SET X=$SELECT($DATA(^DG(43,1,"VERSION")):+^("VERSION"),1:"")
SET VADPT("V")=$SELECT(X<5:0,1:1)
KILL X
QUIT
OERR ;
1 SET VATAG=1
DO MULT
QUIT
2 SET VATAG=2
DO MULT
QUIT
3 SET VATAG=3
DO MULT
QUIT
4 SET VATAG=4
DO MULT
QUIT
5 SET VATAG=5
DO MULT
QUIT
6 SET VATAG=6
DO MULT
QUIT
7 SET VATAG=7
DO MULT
QUIT
8 SET VATAG=8
DO MULT
QUIT
9 SET VATAG=9
DO MULT
QUIT
10 SET VATAG=10
DO MULT
QUIT
51 SET VATAG=11
DO MULT
QUIT
52 SET VATAG=12
DO MULT
QUIT
53 SET VATAG=13
DO MULT
QUIT
ALL SET VATAG=14
DO MULT
QUIT
A5 SET VATAG=15
DO MULT
QUIT
SEL IF $ORDER(VARRAY(0))']""
QUIT
SET VATAG=0
SET VATAG(2)=$PIECE($TEXT(TAG),";;",2)
+1 FOR VATAG(1)=0:0
SET VATAG=$ORDER(VARRAY(VATAG))
IF VATAG=""
QUIT
IF VATAG(2)[("^"_VATAG_"^")
SET VARRAY(VATAG)=1
SET VAROOT=$SELECT($DATA(VAROOT(VATAG)):VAROOT(VATAG),1:"")
DO @VATAG
+2 GOTO Q
+3 ;
MULT SET VATAG=$PIECE($TEXT(TG+VATAG),";;",2)
+1 FOR VATAG(1)=1:1
SET VATAG(2)=$PIECE(VATAG,"^",VATAG(1))
IF VATAG(2)=""
QUIT
SET VAROOT=$SELECT($DATA(VAROOT(VATAG(2))):VAROOT(VATAG(2)),1:"")
DO @(VATAG(2))
Q SET VAROOT=""
KILL VATAG
QUIT
+1 ;
KVA KILL VA
KVAR DO JOB^BLRPARAM
DO KVAR^BLRDPT0
IF $DATA(VAIP("V"))
KILL @(VAIP("V"))
KILL I,X,Y,VARRAY,VADM,VAPD,VADPT,VAOA,VASV,VAEL,VAMB,VARP,VAEN,VASD,VAIN,VAIP,VAPA,VAHOW,VAINDT,VAERR,^UTILITY("VADPT",$JOB),VA200,VATEST
QUIT
+1 ;
TG ;
+1 ;;DEM^INP
+2 ;;DEM^ELIG
+3 ;;ELIG^INP
+4 ;;DEM^ADD
+5 ;;ADD^INP
+6 ;;DEM^ELIG^ADD
+7 ;;ELIG^SVC
+8 ;;ELIG^SVC^MB
+9 ;;DEM^REG^SDE^SDA
+10 ;;SDE^SDA
+11 ;;DEM^IN5
+12 ;;ELIG^IN5
+13 ;;ADD^IN5
+14 ;;DEM^OPD^INP^ADD^ELIG^SVC^OAD^MB^REG^SDE^SDA
+15 ;;DEM^OPD^IN5^ADD^ELIG^SVC^OAD^MB^REG^SDE^SDA
+16 ;
TAG ;;^DEM^OPD^INP^IN5^ADD^OAD^ELIG^SVC^MB^REG^SDE^SDA^
