Routine: DG1010P6

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

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 "

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)

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

DG1010P6.m