- 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
