DGRPTP2 ;ALB/RMO - Print 10-10T Registration Cont.;10 JAN 1997 09:06 am
;;5.3;Registration;**108**;08/13/93
;
EN(DFN,DFN1,DGNAM,DGSSN,DGLNE,DGPGE) ;Entry point to print 10-10T cont.
; Input -- DFN Patient IEN
; DFN1 Disposition multiple IEN (optional)
; DGNAM Patient name
; DGSSN Patient ssn
; DGLNE Line format array
; DGPGE Page number
; Output -- None
D INS(DFN,.DGLNE) ;insurance
D SER(DFN,.DGLNE) ;service branch and number, marital
D SPO(DFN,.DGLNE) ;spouse, income
S DGPGE=1 D FT^DGRPTP(DFN,$G(DFN1),.DGLNE,.DGPGE) ;end of first page of form
D HD^DGRPTP(DGNAM,DGSSN,.DGLNE) ;header
D EN^DGRPTP3(.DGLNE) ;consent, co-pay, signature block, burden, privacy act
S DGPGE=2 D FT^DGRPTP(DFN,$G(DFN1),.DGLNE,.DGPGE) ;end of second page of form
Q
;
INS(DFN,DGLNE) ;Insurance
; Input -- DFN Patient IEN
; DGLNE Line format array
; Output -- None
N C,DGINS,DGRP,I,Y
;
;Insurance
W !,"14A. Do You Have Health Coverage",?40,"|14B. Name of Health Insurance Carrier"
S DGRP(.31)=$G(^DPT(DFN,.31)) ;insurance
S Y=$P(DGRP(.31),U,11),C=$P(^DD(2,.3192,0),U,2) D Y^DIQ
W !,?5,$S(Y'="":Y,1:"UNANSWERED")
D ALL^IBCNS1(DFN,"DGINS",1,DT)
S (C,I)=0 F S I=$O(DGINS(I)) Q:'I S DGINS=DGINS(I,0) D
. S C=C+1
. W:C>1 !
. W ?40,"| ",$$POINT^DG1010P0(DGINS,1,36)
I '$D(DGINS) D
. W ?40,"| ","NO ACTIVE (UNEXPIRED) INSURANCE ON FILE FOR THIS APPLICANT"
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
Q
;
SER(DFN,DGLNE) ;Service branch and number, marital status
; Input -- DFN Patient IEN
; DGLNE Line format array
; Output -- None
N C,DGRP,Y
;
;Service branch and number
W !,"15. Branch of Service",?33,"|16. Latest Service Number",?65,"|17. Marital Status"
S DGRP(.32)=$G(^DPT(DFN,.32)) ;military service
W !?4,$E($$POINT^DG1010P0(DGRP(.32),5,23),1,20)
W ?33,"| ",$$DISP^DG1010P0(DGRP(.32),8)
;
;Marital status
S DGRP(0)=$G(^DPT(DFN,0)) ;patient
S Y=$P(DGRP(0),U,5),C=$P(^DD(2,.05,0),U,2) D Y^DIQ
W ?65,"| ",$S(Y'="":Y,1:"UNANSWERED")
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
Q
;
SPO(DFN,DGLNE) ;Spouse and income
; Input -- DFN Patient IEN
; DGLNE Line format array
; Output -- None
N C,DGDEP,DGINC,DGINR,DGLYINC,DGREL,DGSP,X,Y
;
;Spouse's name, ssn
W !,"18A. Spouse's Name",?65,"|18B. Spouse's Social Security Number"
D ALL^DGMTU21(DFN,"VS",DT,"IPR")
S X=$P($G(DGREL("S")),U,2)
S DGSP(0)=$S(X'="":$G(@(U_$P(X,";",2)_+X_",0)")),1:"")
I DGSP(0)'="" D
. W !?5,$$DISP^DG1010P0(DGSP(0),1)
. S X=$P(DGSP(0),U,9)
. W ?65,"| ",$S(X'="":$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10),1:"")
ELSE D
. W !?5,"NOT APPLICABLE"
. W ?65,"|"
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
;
;Year of marriage, number of dependents, income
W !,"18C. Year of Marriage",?33,"|18D. Number of Dependents",?65,"|19. Last Year's Estimated ""Household"" Taxable Income",!
I DGSP(0)'="" D
. W ?5,$$DATENP^DG1010P0($G(^DGPR(408.12,+DGREL("S"),"E",1,0)),1)
S DGLYINC=$P($G(^DGMT(408.21,+$G(DGINC("V")),0)),U,21)
W ?33,"|"
W ?65,"| ",$S(DGLYINC'="":"$"_DGLYINC,1:"UNANSWERED")
Q
DGRPTP2 ;ALB/RMO - Print 10-10T Registration Cont.;10 JAN 1997 09:06 am
+1 ;;5.3;Registration;**108**;08/13/93
+2 ;
EN(DFN,DFN1,DGNAM,DGSSN,DGLNE,DGPGE) ;Entry point to print 10-10T cont.
+1 ; Input -- DFN Patient IEN
+2 ; DFN1 Disposition multiple IEN (optional)
+3 ; DGNAM Patient name
+4 ; DGSSN Patient ssn
+5 ; DGLNE Line format array
+6 ; DGPGE Page number
+7 ; Output -- None
+8 ;insurance
DO INS(DFN,.DGLNE)
+9 ;service branch and number, marital
DO SER(DFN,.DGLNE)
+10 ;spouse, income
DO SPO(DFN,.DGLNE)
+11 ;end of first page of form
SET DGPGE=1
DO FT^DGRPTP(DFN,$GET(DFN1),.DGLNE,.DGPGE)
+12 ;header
DO HD^DGRPTP(DGNAM,DGSSN,.DGLNE)
+13 ;consent, co-pay, signature block, burden, privacy act
DO EN^DGRPTP3(.DGLNE)
+14 ;end of second page of form
SET DGPGE=2
DO FT^DGRPTP(DFN,$GET(DFN1),.DGLNE,.DGPGE)
+15 QUIT
+16 ;
INS(DFN,DGLNE) ;Insurance
+1 ; Input -- DFN Patient IEN
+2 ; DGLNE Line format array
+3 ; Output -- None
+4 NEW C,DGINS,DGRP,I,Y
+5 ;
+6 ;Insurance
+7 WRITE !,"14A. Do You Have Health Coverage",?40,"|14B. Name of Health Insurance Carrier"
+8 ;insurance
SET DGRP(.31)=$GET(^DPT(DFN,.31))
+9 SET Y=$PIECE(DGRP(.31),U,11)
SET C=$PIECE(^DD(2,.3192,0),U,2)
DO Y^DIQ
+10 WRITE !,?5,$SELECT(Y'="":Y,1:"UNANSWERED")
+11 DO ALL^IBCNS1(DFN,"DGINS",1,DT)
+12 SET (C,I)=0
FOR
SET I=$ORDER(DGINS(I))
IF 'I
QUIT
SET DGINS=DGINS(I,0)
Begin DoDot:1
+13 SET C=C+1
+14 IF C>1
WRITE !
+15 WRITE ?40,"| ",$$POINT^DG1010P0(DGINS,1,36)
End DoDot:1
+16 IF '$DATA(DGINS)
Begin DoDot:1
+17 WRITE ?40,"| ","NO ACTIVE (UNEXPIRED) INSURANCE ON FILE FOR THIS APPLICANT"
End DoDot:1
+18 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+19 QUIT
+20 ;
SER(DFN,DGLNE) ;Service branch and number, marital status
+1 ; Input -- DFN Patient IEN
+2 ; DGLNE Line format array
+3 ; Output -- None
+4 NEW C,DGRP,Y
+5 ;
+6 ;Service branch and number
+7 WRITE !,"15. Branch of Service",?33,"|16. Latest Service Number",?65,"|17. Marital Status"
+8 ;military service
SET DGRP(.32)=$GET(^DPT(DFN,.32))
+9 WRITE !?4,$EXTRACT($$POINT^DG1010P0(DGRP(.32),5,23),1,20)
+10 WRITE ?33,"| ",$$DISP^DG1010P0(DGRP(.32),8)
+11 ;
+12 ;Marital status
+13 ;patient
SET DGRP(0)=$GET(^DPT(DFN,0))
+14 SET Y=$PIECE(DGRP(0),U,5)
SET C=$PIECE(^DD(2,.05,0),U,2)
DO Y^DIQ
+15 WRITE ?65,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
+16 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+17 QUIT
+18 ;
SPO(DFN,DGLNE) ;Spouse and income
+1 ; Input -- DFN Patient IEN
+2 ; DGLNE Line format array
+3 ; Output -- None
+4 NEW C,DGDEP,DGINC,DGINR,DGLYINC,DGREL,DGSP,X,Y
+5 ;
+6 ;Spouse's name, ssn
+7 WRITE !,"18A. Spouse's Name",?65,"|18B. Spouse's Social Security Number"
+8 DO ALL^DGMTU21(DFN,"VS",DT,"IPR")
+9 SET X=$PIECE($GET(DGREL("S")),U,2)
+10 SET DGSP(0)=$SELECT(X'="":$GET(@(U_$PIECE(X,";",2)_+X_",0)")),1:"")
+11 IF DGSP(0)'=""
Begin DoDot:1
+12 WRITE !?5,$$DISP^DG1010P0(DGSP(0),1)
+13 SET X=$PIECE(DGSP(0),U,9)
+14 WRITE ?65,"| ",$SELECT(X'="":$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,10),1:"")
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 WRITE !?5,"NOT APPLICABLE"
+17 WRITE ?65,"|"
End DoDot:1
+18 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+19 ;
+20 ;Year of marriage, number of dependents, income
+21 WRITE !,"18C. Year of Marriage",?33,"|18D. Number of Dependents",?65,"|19. Last Year's Estimated ""Household"" Taxable Income",!
+22 IF DGSP(0)'=""
Begin DoDot:1
+23 WRITE ?5,$$DATENP^DG1010P0($GET(^DGPR(408.12,+DGREL("S"),"E",1,0)),1)
End DoDot:1
+24 SET DGLYINC=$PIECE($GET(^DGMT(408.21,+$GET(DGINC("V")),0)),U,21)
+25 WRITE ?33,"|"
+26 WRITE ?65,"| ",$SELECT(DGLYINC'="":"$"_DGLYINC,1:"UNANSWERED")
+27 QUIT
