DGRPTL3 ;ALB/RMO - 10-10T Registration - Build List Area Cont.;26 DEC 1996 08:00 am
;;5.3;Registration;**108**;08/13/93
;
EN(DGARY,DFN,DGLINE,DGCNT) ;Entry point to build list area cont.
; Input -- DGARY Global array subscript
; DFN Patient IEN
; DGLINE Line number
; Output -- DGCNT Number of lines in the list
N C,DGDEP,DGINC,DGINR,DGLYINC,DGREL,DGSP,DGSTART,X,Y
;
;Marital/Spouse
S DGSTART=DGLINE ;starting line number
D SET^DGRPTL1(DGARY,DGLINE,"Marital/Spouse",31,.DGCNT,IORVON,IORVOFF)
;
;Married last year
S DGLINE=DGLINE+1
D ALL^DGMTU21(DFN,"VS",DT,"IPR")
S Y=$P($G(^DGMT(408.22,+$G(DGINR("V")),0)),U,5),C=$P(^DD(408.22,.05,0),U,2) D Y^DIQ
D SET^DGRPTL1(DGARY,DGLINE,"Married Last Year: "_$S(Y'="":Y,1:"UNANSWERED"),1,.DGCNT)
;
;Spouse's name, ssn, dob
S DGLINE=DGLINE+1
S X=$P($G(DGREL("S")),U,2)
S DGSP(0)=$S(X'="":$G(@(U_$P(X,";",2)_+X_",0)")),1:"")
D SET^DGRPTL1(DGARY,DGLINE,"Spouse's Name: "_$E($P(DGSP(0),U),1,20),5,.DGCNT)
S X=$P(DGSP(0),U,9) D SET^DGRPTL1(DGARY,DGLINE,"SS: "_$S(X'="":$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10),1:""),42,.DGCNT)
D SET^DGRPTL1(DGARY,DGLINE,"DOB: "_$S(DGSP(0)'="":$$FTIME^VALM1($P(DGSP(0),U,3)),1:""),59,.DGCNT)
;
;Income
S DGLINE=DGLINE+1
D SET^DGRPTL1(DGARY,DGLINE,"",1,.DGCNT)
S DGLINE=DGLINE+1
S DGLYINC=$P($G(^DGMT(408.21,+$G(DGINC("V")),0)),U,21)
D SET^DGRPTL1(DGARY,DGLINE,"Income",31,.DGCNT,IORVON,IORVOFF)
S DGLINE=DGLINE+1
D SET^DGRPTL1(DGARY,DGLINE,"Last Year's Estimated ""Household"" Taxable Income: "_$S(DGLYINC'="":"$"_DGLYINC,1:"UNANSWERED"),1,.DGCNT)
;
;Insurance
D INS(DGARY,DFN,.DGLINE,.DGCNT)
Q
;
INS(DGARY,DFN,DGLINE,DGCNT) ;Insurance
; Input -- DGARY Global array subscript
; DFN Patient IEN
; DGLINE Line number
; Output -- DGCNT Number of lines in the list
N C,DGINS,DGRP,I,X,Y
;
;Insurance
S DGLINE=DGLINE+1
D SET^DGRPTL1(DGARY,DGLINE,"",1,.DGCNT)
S DGLINE=DGLINE+1
S DGRP(.31)=$G(^DPT(DFN,.31)) ;insurance
D SET^DGRPTL1(DGARY,DGLINE,"Insurance",31,.DGCNT,IORVON,IORVOFF)
S DGLINE=DGLINE+1
S Y=$P(DGRP(.31),U,11),C=$P(^DD(2,.3192,0),U,2) D Y^DIQ
D SET^DGRPTL1(DGARY,DGLINE,"Covered by Health Insurance: "_$S(Y'="":Y,1:"UNANSWERED"),1,.DGCNT)
;
;List insurance
S DGLINE=DGLINE+1
D SET^DGRPTL1(DGARY,DGLINE,"",1,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGRPTL1(DGARY,DGLINE,"Insurance Co. Subscriber ID Group Holder Effective Expires",1,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGRPTL1(DGARY,DGLINE,"============================================================================",1,.DGCNT)
D ALL^IBCNS1(DFN,"DGINS")
S I=0 F S I=$O(DGINS(I)) Q:'I S DGINS=DGINS(I,0) D
. S DGLINE=DGLINE+1
. D SET^DGRPTL1(DGARY,DGLINE,$S($D(^DIC(36,+DGINS,0)):$E($P(^(0),U,1),1,16),1:"UNKNOWN"),1,.DGCNT)
. D SET^DGRPTL1(DGARY,DGLINE,$E($P(DGINS,U,2),1,16),20,.DGCNT)
. D SET^DGRPTL1(DGARY,DGLINE,$E($$GRP^IBCNS($P(DGINS,U,18)),1,10),38,.DGCNT)
. S X=$P(DGINS,U,6) D SET^DGRPTL1(DGARY,DGLINE,$S(X="v":"SELF",X="s":"SPOUSE",1:"OTHER"),50,.DGCNT)
. D SET^DGRPTL1(DGARY,DGLINE,$S($P(DGINS,U,8)'="":$$FDATE^VALM1($P(DGINS,U,8)),1:""),58,.DGCNT)
. D SET^DGRPTL1(DGARY,DGLINE,$S($P(DGINS,U,4)'="":$$FDATE^VALM1($P(DGINS,U,4)),1:""),67,.DGCNT)
I '$D(DGINS) D
. S DGLINE=DGLINE+1
. D SET^DGRPTL1(DGARY,DGLINE,"No Insurance Information",1,.DGCNT)
Q
DGRPTL3 ;ALB/RMO - 10-10T Registration - Build List Area Cont.;26 DEC 1996 08:00 am
+1 ;;5.3;Registration;**108**;08/13/93
+2 ;
EN(DGARY,DFN,DGLINE,DGCNT) ;Entry point to build list area cont.
+1 ; Input -- DGARY Global array subscript
+2 ; DFN Patient IEN
+3 ; DGLINE Line number
+4 ; Output -- DGCNT Number of lines in the list
+5 NEW C,DGDEP,DGINC,DGINR,DGLYINC,DGREL,DGSP,DGSTART,X,Y
+6 ;
+7 ;Marital/Spouse
+8 ;starting line number
SET DGSTART=DGLINE
+9 DO SET^DGRPTL1(DGARY,DGLINE,"Marital/Spouse",31,.DGCNT,IORVON,IORVOFF)
+10 ;
+11 ;Married last year
+12 SET DGLINE=DGLINE+1
+13 DO ALL^DGMTU21(DFN,"VS",DT,"IPR")
+14 SET Y=$PIECE($GET(^DGMT(408.22,+$GET(DGINR("V")),0)),U,5)
SET C=$PIECE(^DD(408.22,.05,0),U,2)
DO Y^DIQ
+15 DO SET^DGRPTL1(DGARY,DGLINE,"Married Last Year: "_$SELECT(Y'="":Y,1:"UNANSWERED"),1,.DGCNT)
+16 ;
+17 ;Spouse's name, ssn, dob
+18 SET DGLINE=DGLINE+1
+19 SET X=$PIECE($GET(DGREL("S")),U,2)
+20 SET DGSP(0)=$SELECT(X'="":$GET(@(U_$PIECE(X,";",2)_+X_",0)")),1:"")
+21 DO SET^DGRPTL1(DGARY,DGLINE,"Spouse's Name: "_$EXTRACT($PIECE(DGSP(0),U),1,20),5,.DGCNT)
+22 SET X=$PIECE(DGSP(0),U,9)
DO SET^DGRPTL1(DGARY,DGLINE,"SS: "_$SELECT(X'="":$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,10),1:""),42,.DGCNT)
+23 DO SET^DGRPTL1(DGARY,DGLINE,"DOB: "_$SELECT(DGSP(0)'="":$$FTIME^VALM1($PIECE(DGSP(0),U,3)),1:""),59,.DGCNT)
+24 ;
+25 ;Income
+26 SET DGLINE=DGLINE+1
+27 DO SET^DGRPTL1(DGARY,DGLINE,"",1,.DGCNT)
+28 SET DGLINE=DGLINE+1
+29 SET DGLYINC=$PIECE($GET(^DGMT(408.21,+$GET(DGINC("V")),0)),U,21)
+30 DO SET^DGRPTL1(DGARY,DGLINE,"Income",31,.DGCNT,IORVON,IORVOFF)
+31 SET DGLINE=DGLINE+1
+32 DO SET^DGRPTL1(DGARY,DGLINE,"Last Year's Estimated ""Household"" Taxable Income: "_$SELECT(DGLYINC'="":"$"_DGLYINC,1:"UNANSWERED"),1,.DGCNT)
+33 ;
+34 ;Insurance
+35 DO INS(DGARY,DFN,.DGLINE,.DGCNT)
+36 QUIT
+37 ;
INS(DGARY,DFN,DGLINE,DGCNT) ;Insurance
+1 ; Input -- DGARY Global array subscript
+2 ; DFN Patient IEN
+3 ; DGLINE Line number
+4 ; Output -- DGCNT Number of lines in the list
+5 NEW C,DGINS,DGRP,I,X,Y
+6 ;
+7 ;Insurance
+8 SET DGLINE=DGLINE+1
+9 DO SET^DGRPTL1(DGARY,DGLINE,"",1,.DGCNT)
+10 SET DGLINE=DGLINE+1
+11 ;insurance
SET DGRP(.31)=$GET(^DPT(DFN,.31))
+12 DO SET^DGRPTL1(DGARY,DGLINE,"Insurance",31,.DGCNT,IORVON,IORVOFF)
+13 SET DGLINE=DGLINE+1
+14 SET Y=$PIECE(DGRP(.31),U,11)
SET C=$PIECE(^DD(2,.3192,0),U,2)
DO Y^DIQ
+15 DO SET^DGRPTL1(DGARY,DGLINE,"Covered by Health Insurance: "_$SELECT(Y'="":Y,1:"UNANSWERED"),1,.DGCNT)
+16 ;
+17 ;List insurance
+18 SET DGLINE=DGLINE+1
+19 DO SET^DGRPTL1(DGARY,DGLINE,"",1,.DGCNT)
+20 SET DGLINE=DGLINE+1
+21 DO SET^DGRPTL1(DGARY,DGLINE,"Insurance Co. Subscriber ID Group Holder Effective Expires",1,.DGCNT)
+22 SET DGLINE=DGLINE+1
+23 DO SET^DGRPTL1(DGARY,DGLINE,"============================================================================",1,.DGCNT)
+24 DO ALL^IBCNS1(DFN,"DGINS")
+25 SET I=0
FOR
SET I=$ORDER(DGINS(I))
IF 'I
QUIT
SET DGINS=DGINS(I,0)
Begin DoDot:1
+26 SET DGLINE=DGLINE+1
+27 DO SET^DGRPTL1(DGARY,DGLINE,$SELECT($DATA(^DIC(36,+DGINS,0)):$EXTRACT($PIECE(^(0),U,1),1,16),1:"UNKNOWN"),1,.DGCNT)
+28 DO SET^DGRPTL1(DGARY,DGLINE,$EXTRACT($PIECE(DGINS,U,2),1,16),20,.DGCNT)
+29 DO SET^DGRPTL1(DGARY,DGLINE,$EXTRACT($$GRP^IBCNS($PIECE(DGINS,U,18)),1,10),38,.DGCNT)
+30 SET X=$PIECE(DGINS,U,6)
DO SET^DGRPTL1(DGARY,DGLINE,$SELECT(X="v":"SELF",X="s":"SPOUSE",1:"OTHER"),50,.DGCNT)
+31 DO SET^DGRPTL1(DGARY,DGLINE,$SELECT($PIECE(DGINS,U,8)'="":$$FDATE^VALM1($PIECE(DGINS,U,8)),1:""),58,.DGCNT)
+32 DO SET^DGRPTL1(DGARY,DGLINE,$SELECT($PIECE(DGINS,U,4)'="":$$FDATE^VALM1($PIECE(DGINS,U,4)),1:""),67,.DGCNT)
End DoDot:1
+33 IF '$DATA(DGINS)
Begin DoDot:1
+34 SET DGLINE=DGLINE+1
+35 DO SET^DGRPTL1(DGARY,DGLINE,"No Insurance Information",1,.DGCNT)
End DoDot:1
+36 QUIT
