Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG284PT1

DG284PT1.m

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