- 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