BLRDPT.m

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^