DG1010P5 ;ALB/REW - PRINT 1010 CONT'D PART V ; 15 MAR 92
;;5.3;Registration;;Aug 13, 1993
;;1
;NOTE: Due to space reasons, the convention of having the code for
; section 'n' in DG1010Pn is modified. The question #11 code
; is in DG1010PX.
PARTV ;
W !?50,"PART V - ELIGIBILITY STATUS DATA",!,DGLUND
W !,"1. PATIENT TYPE: ",$$POINT^DG1010P0(DGP("TYPE"),1,"^DG(391,"),!,DGLUND
W !,"2. IS NEED FOR MEDICAL CARE RELATED TO AN",?44,"| ","3. IS THE NEED FOR MEDICAL CARE RELATED",?89,"| ","4. IS PATIENT ELIGIBLE FOR MEDICAID:"
W !," ON THE JOB INJURY: ",$$YN2(DGP("DIS2"),1),?44,"| ",?50,"TO AN ACCIDENT: ",$$YN2(DGP("DIS2"),4),?89,"| ",?95,$$YN2(DGP(.38),1),?131,$C(13),DGLUND
W !,"5A. DOES PATIENT HAVE HEALTH INSURANCE",?44,"| ","5B. IF YES, COVERAGE PROVIDED BY:"
W !?4,"COVERAGE: ",$$YN2(DGP(.31),11),?44,"| ",?50
I X'="Y" W "NOT APPLICABLE" G GI
INSINFO ;
S (DGVT,DGSP,DGOT)=""
F DGINS=0:0 S DGINS=$O(^DPT(DFN,.312,DGINS)) Q:DGINS'>0 D
.S DGI=^DPT(DFN,.312,DGINS,0)
.I $S(($P(DGI,U,8)>(9999999-DFN1)):1,($P(DGI,U,4)']""):0,((9999999-DFN1)>$P(DGI,U,4)):1,1:0) Q
.I $P(DGI,U,6)="v" S DGVT="PATIENT'S INSURANCE"
.I $P(DGI,U,6)="s" S DGSP="SPOUSE'S INSURANCE"
.I $P(DGI,U,6)="o" S DGOT="OTHER"
I DGVT_DGSP_DGOT="" W "NO ACTIVE (UNEXPIRED) INSURANCE ON FILE FOR THIS APPLICANT"
I DGVT_DGSP_DGOT'="" W DGVT_$S((DGVT'="")&((DGSP_DGOT)'=""):" & ",1:"")_DGSP_$S((DGOT'="")&((DGVT_DGSP)'=""):" & ",1:"")_DGOT
GI W ?131,$C(13),DGLUND
W !,"6. DOES VETERAN HAVE GI",?31,"| ","7. PRIMARY ELIGIBILITY CODE",?65,"| ","8. OTHER ELIGIBILITY CODE",?98,"| ","9. PERIOD OF SERVICE"
W !?4,"INSURANCE: ",$$YN2(DGP(.362),17),?31,"| ",?36,$$ELIG($P(DGP(.36),U,1)),?65,"| ",?70
S DGOTHER=$O(^DPT(DFN,"E",0)) S:(DGOTHER=DGE)&($L(DGE)) DGOTHER=$O(^DPT(DFN,"E",DGOTHER))
S DGX=DGE
W $$ELIG(DGOTHER),?98,"| ",?103,$$POINT^DG1010P0(DGP(.32),3,21,1,0,1)
I 'DGUNK!DGOTHER F D Q:(DGUNK)!(DGOTHER="")
.S DGOTHER=$O(^DPT(DFN,"E",DGOTHER)),DGD=$$ELIG(DGOTHER)
.Q:(DGUNK)!(DGX=DGOTHER)
.W !,?31,"| ",?65,"| ",?70,DGD,?98,"| "
W ?131,$C(13),DGLUND
SCCOND ;
;RATED=.372 STATED=.373
S DGSC=$S((($P(DGP(.3),U,1)="Y")&($P(DGP(.361),U,1)="V")):.372,($O(^DPT(DFN,.373,0))>0):.373,($$DISP^DG1010P0(DGP(.3),1)'="Y"):"NA",1:0)
I DGSC=.373 D
.W !,"10. SERVICE CONNECTED CONDITIONS AS STATED BY APPLICANT:"
.S E=0 S E=$O(^DPT(DFN,.373,E)) Q:E'>0 W ?59,$P(^(E,0),U,1)," (",$P(^(0),U,2),"%)"
.F S E=$O(^DPT(DFN,.373,E)) Q:E'>0 W !,?59,$P(^(E,0),U,1)," (",$P(^(0),U,2),"%)"
I DGSC=.372 D
.W !,"10. RATED SERVICE CONNECTED CONDITIONS: "
.S DGFL=1
.F E=0:0 S E=$O(^DPT(DFN,.372,E)) Q:E'>0 S DGP(.372)=$G(^(E,0)) D
..Q:'$$DISP^DG1010P0(DGP(.372),3)
..W ?59,$$POINT^DG1010P0(DGP(.372),1,31)," (",$$DISP^DG1010P0(DGP(.372),2),"%)",!
..S DGFL=0
.W:DGFL "NO RATED SERVICE-CONNECTED CONDITIONS",! K DGFL
I +DGSC=0 W !,"10. SERVICE CONNECTED CONDITIONS: "_$S((DGSC="NA"):"NOT APPLICABLE: NOT A SERVICE-CONNECTED APPLICANT",1:"UNANSWERED"),!
W ?131,$C(13),DGLUND
G Q11PTV^DG1010PX
YN2(N,P) ;
; Ext Val of YES/NO given node & piece.
;IN: N -- Val of Node
; P -- Piece
;OUT:[RETURN] -- Ext Val
S X=$P(N,"^",P)
Q $S((X="Y"):"YES",(X="N"):"NO",(X="U"):"UNKNOWN",(X=""):"UNANSWERED",("0"[X):"NO",("12"[X):"YES",("3"[X):"UNKNOWN",1:"INVALID")
ELIG(X) ;
; Ext Val of Elig
;IN: X -- Pointer to #8
;OUT:[RETURN] -- Ext Val
;OUT [SET] -- DGE (Int Elig Val)
S DGE=X
Q $$UNK^DG1010P0($P($G(^DIC(8,+(X),0)),U,1))
DG1010P5 ;ALB/REW - PRINT 1010 CONT'D PART V ; 15 MAR 92
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;;1
+3 ;NOTE: Due to space reasons, the convention of having the code for
+4 ; section 'n' in DG1010Pn is modified. The question #11 code
+5 ; is in DG1010PX.
PARTV ;
+1 WRITE !?50,"PART V - ELIGIBILITY STATUS DATA",!,DGLUND
+2 WRITE !,"1. PATIENT TYPE: ",$$POINT^DG1010P0(DGP("TYPE"),1,"^DG(391,"),!,DGLUND
+3 WRITE !,"2. IS NEED FOR MEDICAL CARE RELATED TO AN",?44,"| ","3. IS THE NEED FOR MEDICAL CARE RELATED",?89,"| ","4. IS PATIENT ELIGIBLE FOR MEDICAID:"
+4 WRITE !," ON THE JOB INJURY: ",$$YN2(DGP("DIS2"),1),?44,"| ",?50,"TO AN ACCIDENT: ",$$YN2(DGP("DIS2"),4),?89,"| ",?95,$$YN2(DGP(.38),1),?131,$CHAR(13),DGLUND
+5 WRITE !,"5A. DOES PATIENT HAVE HEALTH INSURANCE",?44,"| ","5B. IF YES, COVERAGE PROVIDED BY:"
+6 WRITE !?4,"COVERAGE: ",$$YN2(DGP(.31),11),?44,"| ",?50
+7 IF X'="Y"
WRITE "NOT APPLICABLE"
GOTO GI
INSINFO ;
+1 SET (DGVT,DGSP,DGOT)=""
+2 FOR DGINS=0:0
SET DGINS=$ORDER(^DPT(DFN,.312,DGINS))
IF DGINS'>0
QUIT
Begin DoDot:1
+3 SET DGI=^DPT(DFN,.312,DGINS,0)
+4 IF $SELECT(($PIECE(DGI,U,8)>(9999999-DFN1)):1,($PIECE(DGI,U,4)']""):0,((9999999-DFN1)>$PIECE(DGI,U,4)):1,1:0)
QUIT
+5 IF $PIECE(DGI,U,6)="v"
SET DGVT="PATIENT'S INSURANCE"
+6 IF $PIECE(DGI,U,6)="s"
SET DGSP="SPOUSE'S INSURANCE"
+7 IF $PIECE(DGI,U,6)="o"
SET DGOT="OTHER"
End DoDot:1
+8 IF DGVT_DGSP_DGOT=""
WRITE "NO ACTIVE (UNEXPIRED) INSURANCE ON FILE FOR THIS APPLICANT"
+9 IF DGVT_DGSP_DGOT'=""
WRITE DGVT_$SELECT((DGVT'="")&((DGSP_DGOT)'=""):" & ",1:"")_DGSP_$SELECT((DGOT'="")&((DGVT_DGSP)'=""):" & ",1:"")_DGOT
GI WRITE ?131,$CHAR(13),DGLUND
+1 WRITE !,"6. DOES VETERAN HAVE GI",?31,"| ","7. PRIMARY ELIGIBILITY CODE",?65,"| ","8. OTHER ELIGIBILITY CODE",?98,"| ","9. PERIOD OF SERVICE"
+2 WRITE !?4,"INSURANCE: ",$$YN2(DGP(.362),17),?31,"| ",?36,$$ELIG($PIECE(DGP(.36),U,1)),?65,"| ",?70
+3 SET DGOTHER=$ORDER(^DPT(DFN,"E",0))
IF (DGOTHER=DGE)&($LENGTH(DGE))
SET DGOTHER=$ORDER(^DPT(DFN,"E",DGOTHER))
+4 SET DGX=DGE
+5 WRITE $$ELIG(DGOTHER),?98,"| ",?103,$$POINT^DG1010P0(DGP(.32),3,21,1,0,1)
+6 IF 'DGUNK!DGOTHER
FOR
Begin DoDot:1
+7 SET DGOTHER=$ORDER(^DPT(DFN,"E",DGOTHER))
SET DGD=$$ELIG(DGOTHER)
+8 IF (DGUNK)!(DGX=DGOTHER)
QUIT
+9 WRITE !,?31,"| ",?65,"| ",?70,DGD,?98,"| "
End DoDot:1
IF (DGUNK)!(DGOTHER="")
QUIT
+10 WRITE ?131,$CHAR(13),DGLUND
SCCOND ;
+1 ;RATED=.372 STATED=.373
+2 SET DGSC=$SELECT((($PIECE(DGP(.3),U,1)="Y")&($PIECE(DGP(.361),U,1)="V")):.372,($ORDER(^DPT(DFN,.373,0))>0):.373,($$DISP^DG1010P0(DGP(.3),1)'="Y"):"NA",1:0)
+3 IF DGSC=.373
Begin DoDot:1
+4 WRITE !,"10. SERVICE CONNECTED CONDITIONS AS STATED BY APPLICANT:"
+5 SET E=0
SET E=$ORDER(^DPT(DFN,.373,E))
IF E'>0
QUIT
WRITE ?59,$PIECE(^(E,0),U,1)," (",$PIECE(^(0),U,2),"%)"
+6 FOR
SET E=$ORDER(^DPT(DFN,.373,E))
IF E'>0
QUIT
WRITE !,?59,$PIECE(^(E,0),U,1)," (",$PIECE(^(0),U,2),"%)"
End DoDot:1
+7 IF DGSC=.372
Begin DoDot:1
+8 WRITE !,"10. RATED SERVICE CONNECTED CONDITIONS: "
+9 SET DGFL=1
+10 FOR E=0:0
SET E=$ORDER(^DPT(DFN,.372,E))
IF E'>0
QUIT
SET DGP(.372)=$GET(^(E,0))
Begin DoDot:2
+11 IF '$$DISP^DG1010P0(DGP(.372),3)
QUIT
+12 WRITE ?59,$$POINT^DG1010P0(DGP(.372),1,31)," (",$$DISP^DG1010P0(DGP(.372),2),"%)",!
+13 SET DGFL=0
End DoDot:2
+14 IF DGFL
WRITE "NO RATED SERVICE-CONNECTED CONDITIONS",!
KILL DGFL
End DoDot:1
+15 IF +DGSC=0
WRITE !,"10. SERVICE CONNECTED CONDITIONS: "_$SELECT((DGSC="NA"):"NOT APPLICABLE: NOT A SERVICE-CONNECTED APPLICANT",1:"UNANSWERED"),!
+16 WRITE ?131,$CHAR(13),DGLUND
+17 GOTO Q11PTV^DG1010PX
YN2(N,P) ;
+1 ; Ext Val of YES/NO given node & piece.
+2 ;IN: N -- Val of Node
+3 ; P -- Piece
+4 ;OUT:[RETURN] -- Ext Val
+5 SET X=$PIECE(N,"^",P)
+6 QUIT $SELECT((X="Y"):"YES",(X="N"):"NO",(X="U"):"UNKNOWN",(X=""):"UNANSWERED",("0"[X):"NO",("12"[X):"YES",("3"[X):"UNKNOWN",1:"INVALID")
ELIG(X) ;
+1 ; Ext Val of Elig
+2 ;IN: X -- Pointer to #8
+3 ;OUT:[RETURN] -- Ext Val
+4 ;OUT [SET] -- DGE (Int Elig Val)
+5 SET DGE=X
+6 QUIT $$UNK^DG1010P0($PIECE($GET(^DIC(8,+(X),0)),U,1))
