DGMTU22 ;ALB/CAW - COPY PRIOR YEAR INCOME INFORMATION; 6/18/92
;;5.3;Registration;**33,45,624,688**;Aug 13, 1993;Build 29
;
NOBUCKS(DFN,DGDT) ; Used by Income Screen Checks if BOTH
; NO meaningful Income Data for Prior Year
; AND there is data for Year before Prior Year
; 2=YES (but some edit/entry in 408.22),1=YES & 0=NO
; ** REQUIRES DGINR("V")
N DGCURR,DGPRIEN,DGPRIOR,DGPY,DGLY,DGIAI,DGIR,DGY,DGINP
I $G(DGNOCOPY) S DGY=0 G QTNB
S:'$D(DGDT) DGDT=DT
S DGLY=$E(DGDT,1,3)_"0000"-10000,DGPY=DGLY-10000
S (DGPRIOR,DGCURR)=0
F DGPRIEN=0:0 S DGPRIEN=$O(^DGPR(408.12,"B",DFN,DGPRIEN)) Q:'DGPRIEN D
.S:$D(^DGMT(408.21,"AI",+DGPRIEN,-DGPY)) DGPRIOR=DGPRIOR+1
.S DGIAI=$$IAI^DGMTU3(+DGPRIEN,DGLY)
.I DGIAI]"" D
..S DGCURR=DGCURR+$S($P($G(^DGMT(408.21,DGIAI,0)),U,8,18)'?."^":1,($P($G(^(1)),U,1,3)]""):1,($P($G(^(2)),U,1,5)]""):1,1:0)
..;S DGINP=$O(^DGMT(408.22,"AIND",+DGIAI,"")) I $P($G(^DGMT(408.22,+DGINP,"MT")),U) S DGCURR=DGCURR+1
I 'DGPRIOR!DGCURR S DGY=0 G QTNB
S DGIR=$G(^DGMT(408.22,+$G(DGINR("V")),0))
S DGY=$S($P(DGIR,U,5)]"":2,($P(DGIR,U,13)]""):2,1:1)
QTNB Q DGY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTU22 1119 printed Nov 22, 2024@17:55:35 Page 2
DGMTU22 ;ALB/CAW - COPY PRIOR YEAR INCOME INFORMATION; 6/18/92
+1 ;;5.3;Registration;**33,45,624,688**;Aug 13, 1993;Build 29
+2 ;
NOBUCKS(DFN,DGDT) ; Used by Income Screen Checks if BOTH
+1 ; NO meaningful Income Data for Prior Year
+2 ; AND there is data for Year before Prior Year
+3 ; 2=YES (but some edit/entry in 408.22),1=YES & 0=NO
+4 ; ** REQUIRES DGINR("V")
+5 NEW DGCURR,DGPRIEN,DGPRIOR,DGPY,DGLY,DGIAI,DGIR,DGY,DGINP
+6 IF $GET(DGNOCOPY)
SET DGY=0
GOTO QTNB
+7 if '$DATA(DGDT)
SET DGDT=DT
+8 SET DGLY=$EXTRACT(DGDT,1,3)_"0000"-10000
SET DGPY=DGLY-10000
+9 SET (DGPRIOR,DGCURR)=0
+10 FOR DGPRIEN=0:0
SET DGPRIEN=$ORDER(^DGPR(408.12,"B",DFN,DGPRIEN))
if 'DGPRIEN
QUIT
Begin DoDot:1
+11 if $DATA(^DGMT(408.21,"AI",+DGPRIEN,-DGPY))
SET DGPRIOR=DGPRIOR+1
+12 SET DGIAI=$$IAI^DGMTU3(+DGPRIEN,DGLY)
+13 IF DGIAI]""
Begin DoDot:2
+14 SET DGCURR=DGCURR+$SELECT($PIECE($GET(^DGMT(408.21,DGIAI,0)),U,8,18)'?."^":1,($PIECE($GET(^(1)),U,1,3)]""):1,($PIECE($GET(^(2)),U,1,5)]""):1,1:0)
+15 ;S DGINP=$O(^DGMT(408.22,"AIND",+DGIAI,"")) I $P($G(^DGMT(408.22,+DGINP,"MT")),U) S DGCURR=DGCURR+1
End DoDot:2
End DoDot:1
+16 IF 'DGPRIOR!DGCURR
SET DGY=0
GOTO QTNB
+17 SET DGIR=$GET(^DGMT(408.22,+$GET(DGINR("V")),0))
+18 SET DGY=$SELECT($PIECE(DGIR,U,5)]"":2,($PIECE(DGIR,U,13)]""):2,1:1)
QTNB QUIT DGY
