DG284PT1 ;alb/sek-DG*5.3*284 post-install utilities ;4/20/2000
;;5.3;Registration;**284,1015**;Aug 13, 1993;Build 21
;
; This routine contains utilities called from ^DG284PT and ^DG284PT2.
;
SRCE(X) ; get source of test...
; X = pointer to 408.34
; returns SOURCE OF INCOME TEST
Q $P($G(^DG(408.34,+X,0)),"^")
;
COUNT(DATE) ; update process tracking mechanisms...
; DATE = inverse date from "AID" x-ref in 408.31
N %,DGMTIY
S DGMTIY=$E(DATE,2,4)-1
S ^XTMP("DGMTPAT",DGMTIY)=+$G(^XTMP("DGMTPAT",DGMTIY))+1
Q
;
EDIT(FILE,IEN,ERR) ; edit records...
; FILE = file number to be edited
; IEN = record number to be edited
; ERR = passed by reference as 0, returned as 1 if errors
; occured during DBS call
N DGMTEDIT,DGMTERR,DGMTTEXT,DGMTFLD,DIERR,I
S DGMTTEXT="F"_$P(FILE,".",2)
F I=1:1 Q:$P($T(@DGMTTEXT+I),";;",2)="" D
.S DGMTFLD=$P($P($T(@DGMTTEXT+I),";;",2),"^")
.S DGMTEDIT(FILE,IEN_",",DGMTFLD)=""
;
; if file is 408.31, add set of purge flag in field 3...
I FILE="408.31" S DGMTEDIT(FILE,IEN_",",3)=$$FMTE^XLFDT($$DT^XLFDT)
;
; do the edit...
K DGMTERR,DIERR
D FILE^DIE("E","DGMTEDIT","DGMTERR")
I $G(DIERR)'="" S ERR=1 D ERRS(FILE,IEN,.DGMTERR)
;
; if file is 408.31, append text to field 50, COMMENT...
I FILE="408.31" D
.K DGMTEDIT
.S DGMTEDIT(1)=" "
.S DGMTEDIT(2)="NOTE: Income-related data fields in this record were purged on"
.S DGMTEDIT(3)=$$FMTE^XLFDT($$DT^XLFDT)_" as required by IRS and/or SSA."
.K DGMTERR,DIERR
.D WP^DIE(408.31,IEN_",",50,"A","DGMTEDIT","DGMTERR")
.I $G(DIERR)'="" S ERR=1 D ERRS(FILE,IEN,.DGMTERR)
Q
;
ERRS(FILE,RECORD,ERRORS) ; process errors from FM DBS calls...
; FILE = file number where editing error occured
; RECORD = record number in which editing error occured
; ERRORS = the DIERR array containing error information
N DGMTFLD,DGMTX,DGMTY
S DGMTX=0
F S DGMTX=$O(ERRORS("DIERR",DGMTX)) Q:'DGMTX D
.S DGMTFLD=ERRORS("DIERR",DGMTX,"PARAM","FIELD")
.S ^XTMP("DGMTPERR",FILE,RECORD,DGMTFLD)=""
.S DGMTY=0
.F S DGMTY=$O(ERRORS("DIERR",DGMTX,"TEXT",DGMTY)) Q:'DGMTY D
..S ^XTMP("DGMTPERR",FILE,RECORD,DGMTFLD,DGMTY)=ERRORS("DIERR",DGMTX,"TEXT",DGMTY)
Q
;
BLDSTR(NSTR,STR,COL,NSL) ; build a string...
; NSTR = a string to be added to STR
; STR = an existing string to which NSTR will be added
; COL = column location at which NSTR will be added to STR
; NSL = length of new string
; returns STR with NSTR appended at the specified COL
; (code borrowed from SETSTR^VALM1)
Q $E(STR_$J("",COL-1),1,COL-1)_$E(NSTR_$J("",NSL),1,NSL)_$E(STR,COL+NSL,999)
;
F22 ; fields in 408.22 to be edited...
;;.07^AMOUNT CONTRIBUTED TO SPOUSE
;;
F21 ; fields in 408.21 to be edited...
;;.08^SOCIAL SECURITY (NOT SSI)
;;.09^U.S. CIVIL SERVICE
;;.1^U.S. RAILROAD RETIREMENT
;;.11^MILITARY RETIREMENT
;;.12^UNEMPLOYMENT COMPENSATION
;;.13^OTHER RETIREMENT
;;.14^TOTAL INCOME FROM EMPLOYMENT
;;.15^INTEREST, DIVIDEND, OR ANNUITY
;;.16^WORKERS COMP. OR BLACK LUNG
;;.17^ALL OTHER INCOME
;;1.01^MEDICAL EXPENSES
;;1.02^FUNERAL AND BURIAL EXPENSES
;;1.03^EDUCATIONAL EXPENSES
;;2.01^CASH, AMOUNTS IN BANK ACCOUNTS
;;2.02^STOCKS AND BONDS
;;2.03^REAL PROPERTY
;;2.04^OTHER PROPERTY OR ASSETS
;;2.05^DEBTS
;;
F31 ; fields in 408.31 to be edited...
;;.04^INCOME
;;.05^NET WORTH
;;.15^DEDUCTIBLE EXPENSES
;;
DG284PT1 ;alb/sek-DG*5.3*284 post-install utilities ;4/20/2000
+1 ;;5.3;Registration;**284,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ; This routine contains utilities called from ^DG284PT and ^DG284PT2.
+4 ;
SRCE(X) ; get source of test...
+1 ; X = pointer to 408.34
+2 ; returns SOURCE OF INCOME TEST
+3 QUIT $PIECE($GET(^DG(408.34,+X,0)),"^")
+4 ;
COUNT(DATE) ; update process tracking mechanisms...
+1 ; DATE = inverse date from "AID" x-ref in 408.31
+2 NEW %,DGMTIY
+3 SET DGMTIY=$EXTRACT(DATE,2,4)-1
+4 SET ^XTMP("DGMTPAT",DGMTIY)=+$GET(^XTMP("DGMTPAT",DGMTIY))+1
+5 QUIT
+6 ;
EDIT(FILE,IEN,ERR) ; edit records...
+1 ; FILE = file number to be edited
+2 ; IEN = record number to be edited
+3 ; ERR = passed by reference as 0, returned as 1 if errors
+4 ; occured during DBS call
+5 NEW DGMTEDIT,DGMTERR,DGMTTEXT,DGMTFLD,DIERR,I
+6 SET DGMTTEXT="F"_$PIECE(FILE,".",2)
+7 FOR I=1:1
IF $PIECE($TEXT(@DGMTTEXT+I),";;",2)=""
QUIT
Begin DoDot:1
+8 SET DGMTFLD=$PIECE($PIECE($TEXT(@DGMTTEXT+I),";;",2),"^")
+9 SET DGMTEDIT(FILE,IEN_",",DGMTFLD)=""
End DoDot:1
+10 ;
+11 ; if file is 408.31, add set of purge flag in field 3...
+12 IF FILE="408.31"
SET DGMTEDIT(FILE,IEN_",",3)=$$FMTE^XLFDT($$DT^XLFDT)
+13 ;
+14 ; do the edit...
+15 KILL DGMTERR,DIERR
+16 DO FILE^DIE("E","DGMTEDIT","DGMTERR")
+17 IF $GET(DIERR)'=""
SET ERR=1
DO ERRS(FILE,IEN,.DGMTERR)
+18 ;
+19 ; if file is 408.31, append text to field 50, COMMENT...
+20 IF FILE="408.31"
Begin DoDot:1
+21 KILL DGMTEDIT
+22 SET DGMTEDIT(1)=" "
+23 SET DGMTEDIT(2)="NOTE: Income-related data fields in this record were purged on"
+24 SET DGMTEDIT(3)=$$FMTE^XLFDT($$DT^XLFDT)_" as required by IRS and/or SSA."
+25 KILL DGMTERR,DIERR
+26 DO WP^DIE(408.31,IEN_",",50,"A","DGMTEDIT","DGMTERR")
+27 IF $GET(DIERR)'=""
SET ERR=1
DO ERRS(FILE,IEN,.DGMTERR)
End DoDot:1
+28 QUIT
+29 ;
ERRS(FILE,RECORD,ERRORS) ; process errors from FM DBS calls...
+1 ; FILE = file number where editing error occured
+2 ; RECORD = record number in which editing error occured
+3 ; ERRORS = the DIERR array containing error information
+4 NEW DGMTFLD,DGMTX,DGMTY
+5 SET DGMTX=0
+6 FOR
SET DGMTX=$ORDER(ERRORS("DIERR",DGMTX))
IF 'DGMTX
QUIT
Begin DoDot:1
+7 SET DGMTFLD=ERRORS("DIERR",DGMTX,"PARAM","FIELD")
+8 SET ^XTMP("DGMTPERR",FILE,RECORD,DGMTFLD)=""
+9 SET DGMTY=0
+10 FOR
SET DGMTY=$ORDER(ERRORS("DIERR",DGMTX,"TEXT",DGMTY))
IF 'DGMTY
QUIT
Begin DoDot:2
+11 SET ^XTMP("DGMTPERR",FILE,RECORD,DGMTFLD,DGMTY)=ERRORS("DIERR",DGMTX,"TEXT",DGMTY)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
BLDSTR(NSTR,STR,COL,NSL) ; build a string...
+1 ; NSTR = a string to be added to STR
+2 ; STR = an existing string to which NSTR will be added
+3 ; COL = column location at which NSTR will be added to STR
+4 ; NSL = length of new string
+5 ; returns STR with NSTR appended at the specified COL
+6 ; (code borrowed from SETSTR^VALM1)
+7 QUIT $EXTRACT(STR_$JUSTIFY("",COL-1),1,COL-1)_$EXTRACT(NSTR_$JUSTIFY("",NSL),1,NSL)_$EXTRACT(STR,COL+NSL,999)
+8 ;
F22 ; fields in 408.22 to be edited...
+1 ;;.07^AMOUNT CONTRIBUTED TO SPOUSE
+2 ;;
F21 ; fields in 408.21 to be edited...
+1 ;;.08^SOCIAL SECURITY (NOT SSI)
+2 ;;.09^U.S. CIVIL SERVICE
+3 ;;.1^U.S. RAILROAD RETIREMENT
+4 ;;.11^MILITARY RETIREMENT
+5 ;;.12^UNEMPLOYMENT COMPENSATION
+6 ;;.13^OTHER RETIREMENT
+7 ;;.14^TOTAL INCOME FROM EMPLOYMENT
+8 ;;.15^INTEREST, DIVIDEND, OR ANNUITY
+9 ;;.16^WORKERS COMP. OR BLACK LUNG
+10 ;;.17^ALL OTHER INCOME
+11 ;;1.01^MEDICAL EXPENSES
+12 ;;1.02^FUNERAL AND BURIAL EXPENSES
+13 ;;1.03^EDUCATIONAL EXPENSES
+14 ;;2.01^CASH, AMOUNTS IN BANK ACCOUNTS
+15 ;;2.02^STOCKS AND BONDS
+16 ;;2.03^REAL PROPERTY
+17 ;;2.04^OTHER PROPERTY OR ASSETS
+18 ;;2.05^DEBTS
+19 ;;
F31 ; fields in 408.31 to be edited...
+1 ;;.04^INCOME
+2 ;;.05^NET WORTH
+3 ;;.15^DEDUCTIBLE EXPENSES
+4 ;;
