- 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))
