DG53318P ;RTK - Means Test Utilities ;09/22/00
;;5.3;Registration;**318**;Aug 13, 1993
;This routine will edit the SOURCE OF INCOME TEST (.23) field
;of the ANNUAL MEANS TEST (#408.31) file to synchronize it
;with new logic that has been implemented at HEC. The source
;will be set as follows:
;
;If the means test:
; Originated at this site, the source will be set to VAMC
; Originated at another site, the source will be set to
; OTHER FACILITY.
;
;If the site is 742(HEC) or the source is NULL or 2(IVM), no
; action will be taken.
;
EN N DATA,SDATE,MTIEN,ULINE,STATION,NSITE,OSITE,TSOURCE,I,X,X1,X2,%
S (ERRMSG,FILERR)=""
I $D(XPDNM) D
.I $$VERCP^XPDUTL("SDATE")'>0 D
..S %=$$NEWCP^XPDUTL("SDATE","","2970101")
.I $$VERCP^XPDUTL("MTIEN")'>0 D
..S %=$$NEWCP^XPDUTL("MTIEN","","0")
;
F I="RECRD","FIXED","ERORS" D
.I $D(^XTMP("DG-"_I)) Q
.S X1=DT
.S X2=30
.D C^%DTC
.S ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*318 POST-INSTALL "_$S(I="RECRD":"record count",I="FIXED":"records corrected",1:"filing errors")
;
I '$D(XPDNM) S (^XTMP("DG-RECRD",1),^XTMP("DG-FIXED",1))=0
I $D(XPDNM)&'$D(^XTMP("DG-RECRD",1)) S ^XTMP("DG-RECRD",1)=0
I $D(XPDNM)&'$D(^XTMP("DG-FIXED",1)) S ^XTMP("DG-FIXED",1)=0
I $D(XPDNM) S %=$$VERCP^XPDUTL("SDATE")
I $G(%)="" S %=0
I %=0 D EN1
Q
EN1 S SDATE=2970101,MTIEN=""
S STATION=$P($$SITE^VASITE,U,3)
F S SDATE=$O(^DGMT(408.31,"B",SDATE)) Q:SDATE="" D
.F S MTIEN=$O(^DGMT(408.31,"B",SDATE,MTIEN)) Q:MTIEN="" D
..I '$D(^DGMT(408.31,MTIEN,0)) S FILERR(408.31,MTIEN,"ALL")="Means test missing for record "_MTIEN_"." M ^XTMP("DG-ERORS")=FILERR K FILERR Q
..S ULINE=$G(^DGMT(408.31,MTIEN,2))
..S ^XTMP("DG-RECRD",1)=$G(^XTMP("DG-RECRD",1))+1
..S OSITE=$P(ULINE,U,5),TSOURCE=$P($G(^DGMT(408.31,MTIEN,0)),U,23)
..I (OSITE="")!(OSITE[742)!(TSOURCE=2) Q
..I (OSITE[STATION)&(TSOURCE'=1) S DATA(.23)=1 D
...I $$UPD^DGENDBS(408.31,MTIEN,.DATA) S ^XTMP("DG-FIXED",1)=$G(^XTMP("DG-FIXED",1))+1
...E S FILERR(408.31,MTIEN,"ALL")="Unable to edit means test "_MTIEN_"." Q
..I (OSITE'[742)&(OSITE'[STATION)&(TSOURCE'=4) S DATA(.23)=4 D
...I $$UPD^DGENDBS(408.31,MTIEN,.DATA) S ^XTMP("DG-FIXED",1)=$G(^XTMP("DG-FIXED",1))+1
...E S FILERR(408.31,MTIEN,"ALL")="Unable to edit means test "_MTIEN_"." Q
..I $G(FILERR) M ^XTMP("DG-ERORS")=FILERR K FILERR
..I $D(XPDNM) S %=$$UPCP^XPDUTL("MTIEN",MTIEN)
.I $D(XPDNM) S %=$$UPCP^XPDUTL("SDATE",SDATE)
D MAIL^DG53318M
I $D(XPDNM) S %=$$COMCP^XPDUTL("SDATE")
D BMES^XPDUTL(" SOURCE OF INCOME TEST edit process is complete.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53318P 2615 printed Nov 22, 2024@17:47:07 Page 2
DG53318P ;RTK - Means Test Utilities ;09/22/00
+1 ;;5.3;Registration;**318**;Aug 13, 1993
+2 ;This routine will edit the SOURCE OF INCOME TEST (.23) field
+3 ;of the ANNUAL MEANS TEST (#408.31) file to synchronize it
+4 ;with new logic that has been implemented at HEC. The source
+5 ;will be set as follows:
+6 ;
+7 ;If the means test:
+8 ; Originated at this site, the source will be set to VAMC
+9 ; Originated at another site, the source will be set to
+10 ; OTHER FACILITY.
+11 ;
+12 ;If the site is 742(HEC) or the source is NULL or 2(IVM), no
+13 ; action will be taken.
+14 ;
EN NEW DATA,SDATE,MTIEN,ULINE,STATION,NSITE,OSITE,TSOURCE,I,X,X1,X2,%
+1 SET (ERRMSG,FILERR)=""
+2 IF $DATA(XPDNM)
Begin DoDot:1
+3 IF $$VERCP^XPDUTL("SDATE")'>0
Begin DoDot:2
+4 SET %=$$NEWCP^XPDUTL("SDATE","","2970101")
End DoDot:2
+5 IF $$VERCP^XPDUTL("MTIEN")'>0
Begin DoDot:2
+6 SET %=$$NEWCP^XPDUTL("MTIEN","","0")
End DoDot:2
End DoDot:1
+7 ;
+8 FOR I="RECRD","FIXED","ERORS"
Begin DoDot:1
+9 IF $DATA(^XTMP("DG-"_I))
QUIT
+10 SET X1=DT
+11 SET X2=30
+12 DO C^%DTC
+13 SET ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^DG*5.3*318 POST-INSTALL "_$S(I="RECRD":"record count",I="FIXED":"records corrected",1:"filing errors")
End DoDot:1
+14 ;
+15 IF '$DATA(XPDNM)
SET (^XTMP("DG-RECRD",1),^XTMP("DG-FIXED",1))=0
+16 IF $DATA(XPDNM)&'$DATA(^XTMP("DG-RECRD",1))
SET ^XTMP("DG-RECRD",1)=0
+17 IF $DATA(XPDNM)&'$DATA(^XTMP("DG-FIXED",1))
SET ^XTMP("DG-FIXED",1)=0
+18 IF $DATA(XPDNM)
SET %=$$VERCP^XPDUTL("SDATE")
+19 IF $GET(%)=""
SET %=0
+20 IF %=0
DO EN1
+21 QUIT
EN1 SET SDATE=2970101
SET MTIEN=""
+1 SET STATION=$PIECE($$SITE^VASITE,U,3)
+2 FOR
SET SDATE=$ORDER(^DGMT(408.31,"B",SDATE))
if SDATE=""
QUIT
Begin DoDot:1
+3 FOR
SET MTIEN=$ORDER(^DGMT(408.31,"B",SDATE,MTIEN))
if MTIEN=""
QUIT
Begin DoDot:2
+4 IF '$DATA(^DGMT(408.31,MTIEN,0))
SET FILERR(408.31,MTIEN,"ALL")="Means test missing for record "_MTIEN_"."
MERGE ^XTMP("DG-ERORS")=FILERR
KILL FILERR
QUIT
+5 SET ULINE=$GET(^DGMT(408.31,MTIEN,2))
+6 SET ^XTMP("DG-RECRD",1)=$GET(^XTMP("DG-RECRD",1))+1
+7 SET OSITE=$PIECE(ULINE,U,5)
SET TSOURCE=$PIECE($GET(^DGMT(408.31,MTIEN,0)),U,23)
+8 IF (OSITE="")!(OSITE[742)!(TSOURCE=2)
QUIT
+9 IF (OSITE[STATION)&(TSOURCE'=1)
SET DATA(.23)=1
Begin DoDot:3
+10 IF $$UPD^DGENDBS(408.31,MTIEN,.DATA)
SET ^XTMP("DG-FIXED",1)=$GET(^XTMP("DG-FIXED",1))+1
+11 IF '$TEST
SET FILERR(408.31,MTIEN,"ALL")="Unable to edit means test "_MTIEN_"."
QUIT
End DoDot:3
+12 IF (OSITE'[742)&(OSITE'[STATION)&(TSOURCE'=4)
SET DATA(.23)=4
Begin DoDot:3
+13 IF $$UPD^DGENDBS(408.31,MTIEN,.DATA)
SET ^XTMP("DG-FIXED",1)=$GET(^XTMP("DG-FIXED",1))+1
+14 IF '$TEST
SET FILERR(408.31,MTIEN,"ALL")="Unable to edit means test "_MTIEN_"."
QUIT
End DoDot:3
+15 IF $GET(FILERR)
MERGE ^XTMP("DG-ERORS")=FILERR
KILL FILERR
+16 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("MTIEN",MTIEN)
End DoDot:2
+17 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("SDATE",SDATE)
End DoDot:1
+18 DO MAIL^DG53318M
+19 IF $DATA(XPDNM)
SET %=$$COMCP^XPDUTL("SDATE")
+20 DO BMES^XPDUTL(" SOURCE OF INCOME TEST edit process is complete.")
+21 QUIT
