DG1010P6 ;ALB/REW - PRINT 1010 CONT'D PART VI ; 15 MAR 92
;;5.3;Registration;;Aug 13, 1993
;;1
PARTVI D FOOTER^DG1010P2
G:$G(DGSTOP) CLEANUP^DG1010P7
D HEADER^DG1010P2
K DGE,DGINS,DGOT,DGOTHER,DGSC,DGSP,DGVT,DGXX,E
S DGX=9999999-DFN1
S DGISDT=$$LYR^DGMTSCU1(DGX) ;LAST YEAR
D ALL^DGMTU21(DFN,"VSD",DGX,"IPR") ;RETURNS DGDEP,DGREL#,DGINR# & DGINC#
S DGSP=$D(DGREL("S")) ;1=YES SPOUSE LAST YEAR
D TOT^DGRP9(.DGINC)
W !!,?41,"PART VI - INCOME SCREENING DATA OR ANNUAL INCOME",!,$C(13),DGLUND
S DGP(0)=$G(^DPT(DFN,0))
I DGSP=0 D
.S DGRNAM="NOT APPLICABLE",(DGRSEX,DGRSSN,DGRDOB)=""
E D
.S DGDEF=$P($G(DGREL("S")),"^",2)
.S DGPR=+$G(DGREL("S"))
.D SETVAR
SPOUSE W !,"1A. CURRENT MARITAL STATUS: ",$$POINT^DG1010P0(DGP(0),5,11)
W ?56,"| ","1B. DATE OF MARRIAGE: ",$G(DGEFFDT),!,?56,"|",?131,$C(13),DGLUND
S X=$P($G(^DGMT(408.22,+$G(DGINR("V")),0)),U,5)
W !,"2A. WAS PATIENT MARRIED OR SEPARATED AT THE END OF LAST CALENDAR YEAR?: ",$S((X=1):"YES",(X=0):"NO",1:"UNANSWERED"),!,DGLUND
W !,"2B. NAME OF SPOUSE",?36,"| ","2C. SEX OF SPOUSE",?56,"| ","2D. SPOUSE'S SOCIAL SECURITY NO",?97,"| ","2E. SPOUSE'S DATE OF BIRTH"
W !?4,DGRNAM,?36,"| ",?42,DGRSEX,?56,"| ",?62,DGRSSN,?97,"| ",?103,DGRDOB
W ?131,$C(13),DGLUND
DEP W !!,?60,"3. DEPENDENTS",?131,$C(13),DGLUND,!,?32,"| ",?56,"| ",?71,"| ",?90,"| ",?114,"|"
W !?5,"A. NAME",?32,"| ","B. SOCIAL SECURITY NO",?56,"| ","C. SEX",?71,"| ","D. DATE OF BIRTH",?90,"| ","E. RELATIONSHIP",?114,"| ","F. DEPENDENT AS"
W !?32,"| ",?56,"| ",?71,"| ",?90,"| ",?114,"| "," OF (DATE)",?131,$C(13),DGLUND
I DGDEP'=0 D
.F DGCT=1:1 Q:('$D(DGREL("D",DGCT))) D
..S DGDEF=$P(DGREL("D",DGCT),"^",2)
..S DGPR=+$G(DGREL("D",DGCT))
..D SETVAR
..S X=$P($G(^DGPR(408.12,+DGREL("D",DGCT),0)),U,2)
..S X=$P($G(^DG(408.11,+X,0)),U,1),DGREL=$S((X=""):"UNANSWERED",1:X)
..W !,DGCT,?3,"| ",?8,$E(DGRNAM,1,24),?32,"| ",DGRSSN,?56,"| ",DGRSEX,?71,"| ",DGRDOB,?90,"| ",DGREL,?114,"| ",DGEFFDT
E D
.W !?5,"NONE INDICATED",?32,"| ",?56,"| ",?71,"| ",?90,"| ",?114,"| "
W ?131,$C(13),DGLUND
INC W !!,?40,"4. PREVIOUS CALENDAR YEAR (",($E(DGISDT,1,3)+1700),") INCOME INFORMATION",!,$C(13),DGLUND
S X="",$P(X," ",50)="" W !?49,"| ",?86,"AMOUNT",?131,"",$C(13),X," ",$E(DGLUND,51,132)
W !?5,"CHECK ALL APPLICABLE BOXES",?49,"| ",?69,"| ",?89,"| ",?109,"| "
W !,?49,"| ",?54,"VETERAN",?69,"| ",?75,"SPOUSE",?89,"| ",?94,"DEPENDENTS",?109,"| ",?118,"TOTAL",?131,$C(13),DGLUND
S DGGTOT=0
LOOP F I=1:1:10 S DGPCE=$P("8^9^10^11^12^13^14^15^16^17^",U,I) D
.D GETINC
.W !,DGCHECK,?3,"| ",$P($T(INCTEXT+I),";;",2),?49,"| ",$J($$AMT^DGMTSCU1(DGVETINC),15),?69,"| ",$J($$AMT^DGMTSCU1(DGSPOINC),15),?89,"| ",$J($$AMT^DGMTSCU1(DGDEPINC),15),?109,"| ",$J($$AMT^DGMTSCU1(DGTOTINC),15),?131,$C(13),DGLUND
W !?109,"| ",!,?11,"11. TOTAL INCOME",?109,"| ",$J($$AMT^DGMTSCU1(DGGTOT),15),?131,$C(13),DGLUND
K DGEFFDT,DGPR
G PARTVII^DG1010P7
Q
GETINC ;
S DGCHECK=""
S (DGVETINC,DGSPOINC,DGDEPINC,DGTOTINC)=""
I $D(DGTOT("V")) S DGVETINC=$P(DGTOT("V"),U,DGPCE) S DGTOTINC=DGVETINC
I $D(DGTOT("S")) S DGSPOINC=$P(DGTOT("S"),U,DGPCE) S:DGSPOINC]"" DGTOTINC=(+DGTOTINC+DGSPOINC)
I $D(DGTOT("D")) S DGDEPINC=$P(DGTOT("D"),U,DGPCE) S:DGDEPINC]"" DGTOTINC=(+DGTOTINC+DGDEPINC)
I DGTOTINC]"" S DGGTOT=DGGTOT+DGTOTINC,DGCHECK=" X "
Q
SETVAR ;
S (DGRSEX,DGRDOB,DGRSSN)="",DGRNAM="UNANSWERED"
I DGDEF']"" Q
S DGNODE=$G(@(U_$P(DGDEF,";",2)_$P(DGDEF,";",1)_",0)"))
S X=$P(DGNODE,"^",1),DGRNAM=$S((X=""):"UNANSWERED",1:X)
S X=$P(DGNODE,"^",2),DGRSEX=$S((X=""):"UNANSWERED",(X="F"):"FEMALE",(X="M"):"MALE",1:"INVALID")
S Y=$P(DGNODE,"^",3) X ^DD("DD") S DGRDOB=$S((Y=""):"UNANSWERED",1:Y)
S X=$P(DGNODE,"^",9),DGRSSN=$S((X=""):"UNANSWERED",1:$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10))
S DGEFFDT=$$DATENP^DG1010P0($G(^DGPR(408.12,+DGPR,"E",1,0)),1)
Q
INCTEXT ;
;;1. SOCIAL SECURITY (NOT SSI)
;;2. U.S. CIVIL SERVICE
;;3. U.S. RAILROAD RETIREMENT
;;4. MILITARY RETIREMENT
;;5. UNEMPLOYMENT COMPENSATION
;;6. OTHER RETIREMENT
;;7. TOTAL INCOME FROM EMPLOYMENT
;;8. INTEREST, DIVIDEND, OR ANNUITY INCOME
;;9. WORKERS COMPENSATION/BLACK LUNG BENEFITS
;;10. ALL OTHER INCOME
DG1010P6 ;ALB/REW - PRINT 1010 CONT'D PART VI ; 15 MAR 92
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;;1
PARTVI DO FOOTER^DG1010P2
+1 IF $GET(DGSTOP)
GOTO CLEANUP^DG1010P7
+2 DO HEADER^DG1010P2
+3 KILL DGE,DGINS,DGOT,DGOTHER,DGSC,DGSP,DGVT,DGXX,E
+4 SET DGX=9999999-DFN1
+5 ;LAST YEAR
SET DGISDT=$$LYR^DGMTSCU1(DGX)
+6 ;RETURNS DGDEP,DGREL#,DGINR# & DGINC#
DO ALL^DGMTU21(DFN,"VSD",DGX,"IPR")
+7 ;1=YES SPOUSE LAST YEAR
SET DGSP=$DATA(DGREL("S"))
+8 DO TOT^DGRP9(.DGINC)
+9 WRITE !!,?41,"PART VI - INCOME SCREENING DATA OR ANNUAL INCOME",!,$CHAR(13),DGLUND
+10 SET DGP(0)=$GET(^DPT(DFN,0))
+11 IF DGSP=0
Begin DoDot:1
+12 SET DGRNAM="NOT APPLICABLE"
SET (DGRSEX,DGRSSN,DGRDOB)=""
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 SET DGDEF=$PIECE($GET(DGREL("S")),"^",2)
+15 SET DGPR=+$GET(DGREL("S"))
+16 DO SETVAR
End DoDot:1
SPOUSE WRITE !,"1A. CURRENT MARITAL STATUS: ",$$POINT^DG1010P0(DGP(0),5,11)
+1 WRITE ?56,"| ","1B. DATE OF MARRIAGE: ",$GET(DGEFFDT),!,?56,"|",?131,$CHAR(13),DGLUND
+2 SET X=$PIECE($GET(^DGMT(408.22,+$GET(DGINR("V")),0)),U,5)
+3 WRITE !,"2A. WAS PATIENT MARRIED OR SEPARATED AT THE END OF LAST CALENDAR YEAR?: ",$SELECT((X=1):"YES",(X=0):"NO",1:"UNANSWERED"),!,DGLUND
+4 WRITE !,"2B. NAME OF SPOUSE",?36,"| ","2C. SEX OF SPOUSE",?56,"| ","2D. SPOUSE'S SOCIAL SECURITY NO",?97,"| ","2E. SPOUSE'S DATE OF BIRTH"
+5 WRITE !?4,DGRNAM,?36,"| ",?42,DGRSEX,?56,"| ",?62,DGRSSN,?97,"| ",?103,DGRDOB
+6 WRITE ?131,$CHAR(13),DGLUND
DEP WRITE !!,?60,"3. DEPENDENTS",?131,$CHAR(13),DGLUND,!,?32,"| ",?56,"| ",?71,"| ",?90,"| ",?114,"|"
+1 WRITE !?5,"A. NAME",?32,"| ","B. SOCIAL SECURITY NO",?56,"| ","C. SEX",?71,"| ","D. DATE OF BIRTH",?90,"| ","E. RELATIONSHIP",?114,"| ","F. DEPENDENT AS"
+2 WRITE !?32,"| ",?56,"| ",?71,"| ",?90,"| ",?114,"| "," OF (DATE)",?131,$CHAR(13),DGLUND
+3 IF DGDEP'=0
Begin DoDot:1
+4 FOR DGCT=1:1
IF ('$DATA(DGREL("D",DGCT)))
QUIT
Begin DoDot:2
+5 SET DGDEF=$PIECE(DGREL("D",DGCT),"^",2)
+6 SET DGPR=+$GET(DGREL("D",DGCT))
+7 DO SETVAR
+8 SET X=$PIECE($GET(^DGPR(408.12,+DGREL("D",DGCT),0)),U,2)
+9 SET X=$PIECE($GET(^DG(408.11,+X,0)),U,1)
SET DGREL=$SELECT((X=""):"UNANSWERED",1:X)
+10 WRITE !,DGCT,?3,"| ",?8,$EXTRACT(DGRNAM,1,24),?32,"| ",DGRSSN,?56,"| ",DGRSEX,?71,"| ",DGRDOB,?90,"| ",DGREL,?114,"| ",DGEFFDT
End DoDot:2
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 WRITE !?5,"NONE INDICATED",?32,"| ",?56,"| ",?71,"| ",?90,"| ",?114,"| "
End DoDot:1
+13 WRITE ?131,$CHAR(13),DGLUND
INC WRITE !!,?40,"4. PREVIOUS CALENDAR YEAR (",($EXTRACT(DGISDT,1,3)+1700),") INCOME INFORMATION",!,$CHAR(13),DGLUND
+1 SET X=""
SET $PIECE(X," ",50)=""
WRITE !?49,"| ",?86,"AMOUNT",?131,"",$CHAR(13),X," ",$EXTRACT(DGLUND,51,132)
+2 WRITE !?5,"CHECK ALL APPLICABLE BOXES",?49,"| ",?69,"| ",?89,"| ",?109,"| "
+3 WRITE !,?49,"| ",?54,"VETERAN",?69,"| ",?75,"SPOUSE",?89,"| ",?94,"DEPENDENTS",?109,"| ",?118,"TOTAL",?131,$CHAR(13),DGLUND
+4 SET DGGTOT=0
LOOP FOR I=1:1:10
SET DGPCE=$PIECE("8^9^10^11^12^13^14^15^16^17^",U,I)
Begin DoDot:1
+1 DO GETINC
+2 WRITE !,DGCHECK,?3,"| ",$PIECE($TEXT(INCTEXT+I),";;",2),?49,"| ",$JUSTIFY($$AMT^DGMTSCU1(DGVETINC),15),?69,"| ",$JUSTIFY($$AMT^DGMTSCU1(DGSPOINC),15),?89,"| ",$JUSTIFY($$AMT^DGMTSCU1(DGDEPINC),15),?109,"| ",...
... $JUSTIFY($$AMT^DGMTSCU1(DGTOTINC),15),?131,$CHAR(13),DGLUND
End DoDot:1
+3 WRITE !?109,"| ",!,?11,"11. TOTAL INCOME",?109,"| ",$JUSTIFY($$AMT^DGMTSCU1(DGGTOT),15),?131,$CHAR(13),DGLUND
+4 KILL DGEFFDT,DGPR
+5 GOTO PARTVII^DG1010P7
+6 QUIT
GETINC ;
+1 SET DGCHECK=""
+2 SET (DGVETINC,DGSPOINC,DGDEPINC,DGTOTINC)=""
+3 IF $DATA(DGTOT("V"))
SET DGVETINC=$PIECE(DGTOT("V"),U,DGPCE)
SET DGTOTINC=DGVETINC
+4 IF $DATA(DGTOT("S"))
SET DGSPOINC=$PIECE(DGTOT("S"),U,DGPCE)
IF DGSPOINC]""
SET DGTOTINC=(+DGTOTINC+DGSPOINC)
+5 IF $DATA(DGTOT("D"))
SET DGDEPINC=$PIECE(DGTOT("D"),U,DGPCE)
IF DGDEPINC]""
SET DGTOTINC=(+DGTOTINC+DGDEPINC)
+6 IF DGTOTINC]""
SET DGGTOT=DGGTOT+DGTOTINC
SET DGCHECK=" X "
+7 QUIT
SETVAR ;
+1 SET (DGRSEX,DGRDOB,DGRSSN)=""
SET DGRNAM="UNANSWERED"
+2 IF DGDEF']""
QUIT
+3 SET DGNODE=$GET(@(U_$PIECE(DGDEF,";",2)_$PIECE(DGDEF,";",1)_",0)"))
+4 SET X=$PIECE(DGNODE,"^",1)
SET DGRNAM=$SELECT((X=""):"UNANSWERED",1:X)
+5 SET X=$PIECE(DGNODE,"^",2)
SET DGRSEX=$SELECT((X=""):"UNANSWERED",(X="F"):"FEMALE",(X="M"):"MALE",1:"INVALID")
+6 SET Y=$PIECE(DGNODE,"^",3)
XECUTE ^DD("DD")
SET DGRDOB=$SELECT((Y=""):"UNANSWERED",1:Y)
+7 SET X=$PIECE(DGNODE,"^",9)
SET DGRSSN=$SELECT((X=""):"UNANSWERED",1:$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,10))
+8 SET DGEFFDT=$$DATENP^DG1010P0($GET(^DGPR(408.12,+DGPR,"E",1,0)),1)
+9 QUIT
INCTEXT ;
+1 ;;1. SOCIAL SECURITY (NOT SSI)
+2 ;;2. U.S. CIVIL SERVICE
+3 ;;3. U.S. RAILROAD RETIREMENT
+4 ;;4. MILITARY RETIREMENT
+5 ;;5. UNEMPLOYMENT COMPENSATION
+6 ;;6. OTHER RETIREMENT
+7 ;;7. TOTAL INCOME FROM EMPLOYMENT
+8 ;;8. INTEREST, DIVIDEND, OR ANNUITY INCOME
+9 ;;9. WORKERS COMPENSATION/BLACK LUNG BENEFITS
+10 ;;10. ALL OTHER INCOME
