BLRDPT4 ; IHS/DIR/FJE - PATIENT VARIABLES ;
;;5.2;BLR;;NOV 01, 1997
;
;;MAS VERSION 5.0;
7 ;Eligibility [ELIG]
F I=.15,.3,.31,.32,.36,.361,"INE","TYPE","VET" S VAX(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
S VAZ=$P(VAX(.36),"^",1) S:$D(^DIC(8,+VAZ,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",1))=VAZ
S VAX=0 F I=0:0 S VAX=$O(^DPT(DFN,"E",VAX)) Q:VAX'>0 S VAZ=VAX I $D(^DIC(8,+VAZ,0)),+@VAV@($P(VAS,"^"))'=VAZ S VAZ=VAZ_"^"_$P(^DIC(8,+VAZ,0),"^") S @VAV@($P(VAS,"^",1),VAX)=VAZ
S VAZ=$P(VAX(.32),"^",3) S:$D(^DIC(21,+VAZ,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",2))=VAZ
S VAZ=$S($P(VAX(.3),"^",1)="Y":1,1:0) S:VAZ VAZ=VAZ_"^"_$P(VAX(.3),"^",2) S @VAV@($P(VAS,"^",3))=VAZ
S @VAV@($P(VAS,"^",4))=$S(VAX("VET")="Y":1,1:0),VAZ=$S(+$P(VAX(.15),"^",2):0,1:1),@VAV@($P(VAS,"^",5))=VAZ
I VAZ F I=1:1:6 S @VAV@($P(VAS,"^",5),I)="" G 71
S VAZ=$P(VAX(.15),"^",2),Y=VAZ X ^DD("DD") S @VAV@($P(VAS,"^",5),1)=VAZ_"^"_Y,VAZ=$P(VAX("INE"),"^",1) S:VAZ]"" VAZ=VAZ_"^"_$P("VAMC^REGIONAL OFFICE^RPC","^",VAZ) S @VAV@($P(VAS,"^",5),2)=VAZ
S @VAV@($P(VAS,"^",5),3)=$P(VAX("INE"),"^",3),VAZ=$P(VAX("INE"),"^",4) S:$D(^DIC(5,+VAZ,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",5),4)=VAZ
S @VAV@($P(VAS,"^",5),5)=$P(VAX("INE"),"^",6),@VAV@($P(VAS,"^",5),6)=$P(VAX(.3),"^",7)
71 S VAZ=VAX("TYPE") S:$D(^DG(391,+VAZ,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",6))=VAZ
S @VAV@($P(VAS,"^",7))=$P(VAX(.31),"^",3),VAZ=$P(VAX(.361),"^",1) S:VAZ]"" VAZ=VAZ_"^"_$S(VAZ="V":"VERIFIED",VAZ="P":"PENDING VERIFICATION",VAZ="R":"PENDING RE-VERIFICATION",1:"") S @VAV@($P(VAS,"^",8))=VAZ
I $D(^DG(41.3,DFN,0)) S VAZ=$P(^(0),"^",2) I VAZ]"" S VAZ(1)=$S($D(^DD(41.3,2,0)):$P(^(0),"^",3),1:""),VAZ(1)=$P($P(VAZ(1),VAZ_":",2),";",1),@VAV@($P(VAS,"^",9))=VAZ_"^"_VAZ(1)
Q
;
8 ;Monetary Benefits [MB]
S VAX=$S($D(^DPT(DFN,.362)):^(.362),1:""),VAX(1)="0000000000012435607",VAX(2)="0000000000012435906"
F I=12,13,14,15,16,17,19 S VAX(3)=+$E(VAX(2),I),VAZ=$S($P(VAX,"^",I)="Y":1,1:0) S:VAZ VAZ=VAZ_"^"_$P(VAX,"^",+$E(VAX(1),I)) S @VAV@($P(VAS,"^",VAX(3)))=VAZ
S @VAV@($P(VAS,"^",8))=$S(+$P(VAX,"^",8):(1_"^"_$P(VAX,"^",8)),1:0),@VAV@($P(VAS,"^",7))=$S('$D(^DPT(DFN,.3)):0,1:$S($P(^(.3),"^",11)="Y":(1_"^"_$P(^(.3),"^",3)),1:0))
Q
;
9 ;Service information
F I=.32,.321,.52 S VAX(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
S VAX("N")=.321 F I=1,2,3 S VAX(3)=I,VAZ=$S($P(VAX(.321),"^",I)="Y":1,1:0),@VAV@($P(VAS,"^",VAX(3)))=VAZ I VAZ S VAX(1)=$S(I=1:"4^5",I=2:"7^9^8",1:11),VAX(4)=0 D 91
S VAX("N")=.52 F I=5,11 S VAX(3)=$S(I=5:4,1:5),VAX(1)=$S(I=5:"7^8",1:"13^14"),VAZ=$S($P(VAX(.52),"^",I)="Y":1,1:0),@VAV@($P(VAS,"^",VAX(3)))=VAZ I VAZ S VAX(4)=0 D 91
F I=6,7,8 S @VAV@($P(VAS,"^",I))="" F VAX(1)=1:1:5 S @VAV@($P(VAS,"^",I),VAX(1))=""
S VAX("N")=.32,VAZ=$S($P(VAX(.32),"^",5)]"":1,1:0),@VAV@($P(VAS,"^",6))=VAZ I VAZ,$P(VAX(.32),"^",19)="Y" S VAZ=1,@VAV@($P(VAS,"^",7))=VAZ I VAZ,$P(VAX(.32),"^",20)="Y" S @VAV@($P(VAS,"^",8))=1
F I=6,7,8 I @VAV@($P(VAS,"^",I)) S VAX(3)=I,VAX(1)=$S(I=6:"6^7",I=7:"11^12",1:"16^17"),VAX(4)=3 D 91
Q
;
91 F VAX(2)=1:1 S VAX(4)=VAX(4)+1,X=+$P(VAX(1),"^",VAX(2)) Q:'X S X=$P(VAX(VAX("N")),"^",X),VAZ=X,Y=VAZ X:Y]"" ^DD("DD") S @VAV@($P(VAS,"^",VAX(3)),VAX(4))=$S(VAZ]"":VAZ_"^"_Y,1:"")
Q:VAX(3)=1 I VAX(3)=2 S @VAV@($P(VAS,"^",2),4)=$P(VAX(.321),"^",10) Q
I VAX(3)<4 S X=$P(VAX(.321),"^",12),VAZ=X S:X]"" VAZ=VAZ_"^"_$S(X="T":"NUCLEAR TESTING",X="N":"NAGASAKI/HIROSHIMA",1:"BOTH") S @VAV@($P(VAS,"^",3),2)=VAZ Q
I VAX(3)<6 S X=$P(VAX(VAX("N")),"^",$S(VAX(3)=4:6,1:12)),VAZ=X S:$D(^DIC(22,+X,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",VAX(3)),3)=VAZ Q
S X=$S(VAX(3)=6:5,VAX(3)=7:10,1:15),VAX(2)=0 F VAX(5)=X,X+3,X-1 S VAX(2)=VAX(2)+1,VAZ=$P(VAX(VAX("N")),"^",VAX(5)),@VAV@($P(VAS,"^",VAX(3)),VAX(2))=VAZ I "^4^5^9^10^14^15^"[("^"_VAX(5)_"^"),+VAZ D 92
Q
92 S VAX(6)="^DIC("_$S('(VAX(5)#5):23,1:25)_","_+VAZ_",0)" I $D(@(VAX(6))) S VAZ=$P(^(0),"^",1),@VAV@($P(VAS,"^",VAX(3)),VAX(2))=@VAV@($P(VAS,"^",VAX(3)),VAX(2))_"^"_VAZ
Q
BLRDPT4 ; IHS/DIR/FJE - PATIENT VARIABLES ;
+1 ;;5.2;BLR;;NOV 01, 1997
+2 ;
+3 ;;MAS VERSION 5.0;
7 ;Eligibility [ELIG]
+1 FOR I=.15,.3,.31,.32,.36,.361,"INE","TYPE","VET"
SET VAX(I)=$SELECT($DATA(^DPT(DFN,I)):^(I),1:"")
+2 SET VAZ=$PIECE(VAX(.36),"^",1)
IF $DATA(^DIC(8,+VAZ,0))
SET VAZ=VAZ_"^"_$PIECE(^(0),"^",1)
SET @VAV@($PIECE(VAS,"^",1))=VAZ
+3 SET VAX=0
FOR I=0:0
SET VAX=$ORDER(^DPT(DFN,"E",VAX))
IF VAX'>0
QUIT
SET VAZ=VAX
IF $DATA(^DIC(8,+VAZ,0))
IF +@VAV@($PIECE(VAS,"^"))'=VAZ
SET VAZ=VAZ_"^"_$PIECE(^DIC(8,+VAZ,0),"^")
SET @VAV@($PIECE(VAS,"^",1),VAX)=VAZ
+4 SET VAZ=$PIECE(VAX(.32),"^",3)
IF $DATA(^DIC(21,+VAZ,0))
SET VAZ=VAZ_"^"_$PIECE(^(0),"^",1)
SET @VAV@($PIECE(VAS,"^",2))=VAZ
+5 SET VAZ=$SELECT($PIECE(VAX(.3),"^",1)="Y":1,1:0)
IF VAZ
SET VAZ=VAZ_"^"_$PIECE(VAX(.3),"^",2)
SET @VAV@($PIECE(VAS,"^",3))=VAZ
+6 SET @VAV@($PIECE(VAS,"^",4))=$SELECT(VAX("VET")="Y":1,1:0)
SET VAZ=$SELECT(+$PIECE(VAX(.15),"^",2):0,1:1)
SET @VAV@($PIECE(VAS,"^",5))=VAZ
+7 IF VAZ
FOR I=1:1:6
SET @VAV@($PIECE(VAS,"^",5),I)=""
GOTO 71
+8 SET VAZ=$PIECE(VAX(.15),"^",2)
SET Y=VAZ
XECUTE ^DD("DD")
SET @VAV@($PIECE(VAS,"^",5),1)=VAZ_"^"_Y
SET VAZ=$PIECE(VAX("INE"),"^",1)
IF VAZ]""
SET VAZ=VAZ_"^"_$PIECE("VAMC^REGIONAL OFFICE^RPC","^",VAZ)
SET @VAV@($PIECE(VAS,"^",5),2)=VAZ
+9 SET @VAV@($PIECE(VAS,"^",5),3)=$PIECE(VAX("INE"),"^",3)
SET VAZ=$PIECE(VAX("INE"),"^",4)
IF $DATA(^DIC(5,+VAZ,0))
SET VAZ=VAZ_"^"_$PIECE(^(0),"^",1)
SET @VAV@($PIECE(VAS,"^",5),4)=VAZ
+10 SET @VAV@($PIECE(VAS,"^",5),5)=$PIECE(VAX("INE"),"^",6)
SET @VAV@($PIECE(VAS,"^",5),6)=$PIECE(VAX(.3),"^",7)
71 SET VAZ=VAX("TYPE")
IF $DATA(^DG(391,+VAZ,0))
SET VAZ=VAZ_"^"_$PIECE(^(0),"^",1)
SET @VAV@($PIECE(VAS,"^",6))=VAZ
+1 SET @VAV@($PIECE(VAS,"^",7))=$PIECE(VAX(.31),"^",3)
SET VAZ=$PIECE(VAX(.361),"^",1)
IF VAZ]""
SET VAZ=VAZ_"^"_$SELECT(VAZ="V":"VERIFIED",VAZ="P":"PENDING VERIFICATION",VAZ="R":"PENDING RE-VERIFICATION",1:"")
SET @VAV@($PIECE(VAS,"^",8))=VAZ
+2 IF $DATA(^DG(41.3,DFN,0))
SET VAZ=$PIECE(^(0),"^",2)
IF VAZ]""
SET VAZ(1)=$SELECT($DATA(^DD(41.3,2,0)):$PIECE(^(0),"^",3),1:"")
SET VAZ(1)=$PIECE($PIECE(VAZ(1),VAZ_":",2),";",1)
SET @VAV@($PIECE(VAS,"^",9))=VAZ_"^"_VAZ(1)
+3 QUIT
+4 ;
8 ;Monetary Benefits [MB]
+1 SET VAX=$SELECT($DATA(^DPT(DFN,.362)):^(.362),1:"")
SET VAX(1)="0000000000012435607"
SET VAX(2)="0000000000012435906"
+2 FOR I=12,13,14,15,16,17,19
SET VAX(3)=+$EXTRACT(VAX(2),I)
SET VAZ=$SELECT($PIECE(VAX,"^",I)="Y":1,1:0)
IF VAZ
SET VAZ=VAZ_"^"_$PIECE(VAX,"^",+$EXTRACT(VAX(1),I))
SET @VAV@($PIECE(VAS,"^",VAX(3)))=VAZ
+3 SET @VAV@($PIECE(VAS,"^",8))=$SELECT(+$PIECE(VAX,"^",8):(1_"^"_$PIECE(VAX,"^",8)),1:0)
SET @VAV@($PIECE(VAS,"^",7))=$SELECT('$DATA(^DPT(DFN,.3)):0,1:$SELECT($PIECE(^(.3),"^",11)="Y":(1_"^"_$PIECE(^(.3),"^",3)),1:0))
+4 QUIT
+5 ;
9 ;Service information
+1 FOR I=.32,.321,.52
SET VAX(I)=$SELECT($DATA(^DPT(DFN,I)):^(I),1:"")
+2 SET VAX("N")=.321
FOR I=1,2,3
SET VAX(3)=I
SET VAZ=$SELECT($PIECE(VAX(.321),"^",I)="Y":1,1:0)
SET @VAV@($PIECE(VAS,"^",VAX(3)))=VAZ
IF VAZ
SET VAX(1)=$SELECT(I=1:"4^5",I=2:"7^9^8",1:11)
SET VAX(4)=0
DO 91
+3 SET VAX("N")=.52
FOR I=5,11
SET VAX(3)=$SELECT(I=5:4,1:5)
SET VAX(1)=$SELECT(I=5:"7^8",1:"13^14")
SET VAZ=$SELECT($PIECE(VAX(.52),"^",I)="Y":1,1:0)
SET @VAV@($PIECE(VAS,"^",VAX(3)))=VAZ
IF VAZ
SET VAX(4)=0
DO 91
+4 FOR I=6,7,8
SET @VAV@($PIECE(VAS,"^",I))=""
FOR VAX(1)=1:1:5
SET @VAV@($PIECE(VAS,"^",I),VAX(1))=""
+5 SET VAX("N")=.32
SET VAZ=$SELECT($PIECE(VAX(.32),"^",5)]"":1,1:0)
SET @VAV@($PIECE(VAS,"^",6))=VAZ
IF VAZ
IF $PIECE(VAX(.32),"^",19)="Y"
SET VAZ=1
SET @VAV@($PIECE(VAS,"^",7))=VAZ
IF VAZ
IF $PIECE(VAX(.32),"^",20)="Y"
SET @VAV@($PIECE(VAS,"^",8))=1
+6 FOR I=6,7,8
IF @VAV@($PIECE(VAS,"^",I))
SET VAX(3)=I
SET VAX(1)=$SELECT(I=6:"6^7",I=7:"11^12",1:"16^17")
SET VAX(4)=3
DO 91
+7 QUIT
+8 ;
91 FOR VAX(2)=1:1
SET VAX(4)=VAX(4)+1
SET X=+$PIECE(VAX(1),"^",VAX(2))
IF 'X
QUIT
SET X=$PIECE(VAX(VAX("N")),"^",X)
SET VAZ=X
SET Y=VAZ
IF Y]""
XECUTE ^DD("DD")
SET @VAV@($PIECE(VAS,"^",VAX(3)),VAX(4))=$SELECT(VAZ]"":VAZ_"^"_Y,1:"")
+1 IF VAX(3)=1
QUIT
IF VAX(3)=2
SET @VAV@($PIECE(VAS,"^",2),4)=$PIECE(VAX(.321),"^",10)
QUIT
+2 IF VAX(3)<4
SET X=$PIECE(VAX(.321),"^",12)
SET VAZ=X
IF X]""
SET VAZ=VAZ_"^"_$SELECT(X="T":"NUCLEAR TESTING",X="N":"NAGASAKI/HIROSHIMA",1:"BOTH")
SET @VAV@($PIECE(VAS,"^",3),2)=VAZ
QUIT
+3 IF VAX(3)<6
SET X=$PIECE(VAX(VAX("N")),"^",$SELECT(VAX(3)=4:6,1:12))
SET VAZ=X
IF $DATA(^DIC(22,+X,0))
SET VAZ=VAZ_"^"_$PIECE(^(0),"^",1)
SET @VAV@($PIECE(VAS,"^",VAX(3)),3)=VAZ
QUIT
+4 SET X=$SELECT(VAX(3)=6:5,VAX(3)=7:10,1:15)
SET VAX(2)=0
FOR VAX(5)=X,X+3,X-1
SET VAX(2)=VAX(2)+1
SET VAZ=$PIECE(VAX(VAX("N")),"^",VAX(5))
SET @VAV@($PIECE(VAS,"^",VAX(3)),VAX(2))=VAZ
IF "^4^5^9^10^14^15^"[("^"_VAX(5)_"^")
IF +VAZ
DO 92
+5 QUIT
92 SET VAX(6)="^DIC("_$SELECT('(VAX(5)#5):23,1:25)_","_+VAZ_",0)"
IF $DATA(@(VAX(6)))
SET VAZ=$PIECE(^(0),"^",1)
SET @VAV@($PIECE(VAS,"^",VAX(3)),VAX(2))=@VAV@($PIECE(VAS,"^",VAX(3)),VAX(2))_"^"_VAZ
+1 QUIT
