- DG53318P ;RTK - Means Test Utilities ;09/22/00
- ;;5.3;Registration;**318,1015**;Aug 13, 1993;Build 21
- ;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
- DG53318P ;RTK - Means Test Utilities ;09/22/00
- +1 ;;5.3;Registration;**318,1015**;Aug 13, 1993;Build 21
- +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