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

ACRFIRSA.m

Go to the documentation of this file. 
  1. ACRFIRSA ;IHS/OIRM/DSD/AEF/MRS - PRINT 1099s TO FLAT FILE [ 07/20/2006   4:18 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**8,13,20**;NOV 05, 2001
  1.  ; NEW ROUTINE ACR*2.1*8.06
  1. DESC ;;
  1.  ;;  This routine gathers vendor 1099 payment data and puts it into a
  1.  ;;  UNIX comma delimited file to be imported into the Convey package
  1.  ;;  for printing on the Convey created forms -- replaces the ACRF
  1.  ;;  1099 PRINT ALL option for printing 1099's on pre-printed forms.
  1.  ;;
  1.  ;;    NOTE: This routine assumes that all data checks and any
  1.  ;;          necessary edits have been made before this routine
  1.  ;;          is run. You will be asked if this is a test run or
  1.  ;;          if the Vendor file is to be updated.
  1.  ;;
  1.  ;; COLUMN LAYOUT:
  1.  ;;
  1.  ;;  1  VENDOR NAME               8  VENDOR STATE
  1.  ;;  2  SHORT NAME                9  VENODR ZIP CODE          
  1.  ;;  3  VENDOR TIN# (9 DIGITS)   10  FOREIGN ADDRESS (1 or BLANK)  
  1.  ;;  4  TIN TYPE                 11  CYEAR AMOUNT (BOX 7)     
  1.  ;;  5  VENDOR ADDRESS (LINE 1)  12  CYEAR AMOUNT (BOX 6)  
  1.  ;;  6  VENDOR ADDRESS(LINE 2)   13  CORRECTED (X or BLANK)
  1.  ;;  7  VENDOR CITY               
  1.  ;;
  1.  ;;$$END
  1.  ;
  1.  ;      ACRYR     =  PAYMENT YEAR
  1.  ;      ACRNAME   =  VENDOR NAME
  1.  ;      ACRTIN    =  VENDOR TIN#
  1.  ;      ACRTYP    =  TIN TYPE = 2 = SSN; 1= EIN
  1.  ;      ACRADD1   =  VENDOR ADDRESS 1
  1.  ;      ACRADD2   =  VENDOR ADDRESS 2
  1.  ;      ACRCITY   =  VENDOR CITY
  1.  ;      ACRSTAB   =  VENDOR STATE ABBREVIATION
  1.  ;      ACRZIP    =  VENDOR ZIP CODE
  1.  ;      ACRFOR    =  FOREIGN ADDRESS = 1 if TRUE or NULL
  1.  ;      ACRCOR    =  CORRECTED FORM
  1.  ;      ACRVTYP   =  TYPE OF VENDOR (6 or 7)
  1.  ;      ACRAMT    =  VENDOR YTD PAID AMOUNT   BOX 6 or 7
  1.  ;      ACRUP     =  1 = UPDATE FILE; 2 = TEST PRINT ONLY
  1.  ;
  1. EN ;EP -- WRITE ALL VENDOR 1099S INTO FLAT FILE
  1.  ;
  1.  N ACRYR
  1.  ;
  1.  D ^XBKVAR                     ;----- SET SESSION VARIABLES
  1.  D HOME^%ZIS
  1.  D ^XBCLS                      ;----- CLEAR SCREEN
  1.  D TXT                         ;----- WRITE DESCRIPTION
  1.  K ACROUT
  1.  D PAUSE^ACRFWARN
  1.  Q:$D(ACROUT)
  1.  ;
  1.  D ^XBCLS
  1.  D YR^ACRFIRSU(.ACRYR)          ;----- ASK CALENDAR YEAR
  1.  Q:'$G(ACRYR)
  1.  ;
  1.  S ACRUP=$$ASKUP^ACRFIRSU       ;----- ASK UPDATE OR TEST
  1.  Q:'ACRUP
  1.  ;
  1.  D DQ(ACRYR,ACRUP)
  1.  ;
  1.  D PAUSE^ACRFWARN
  1.  Q
  1.  ;
  1. DQ(ACRYR,ACRUP) ;
  1.  ;
  1.  ;      INCOMING VARIABLES:
  1.  ;      ACRYR   = CALENDAR YEAR
  1.  ;      ACRUP   =  UPDATE 1099 VENDOR FILE OR TEST PRINT
  1.  ;
  1.  ;      OTHER VARIABLES USED:
  1.  ;      ACRJ    = $JOB NUMBER
  1.  ;
  1.  N ACRJ
  1.  ;
  1.  S ACRJ=$J
  1.  K ^TMP("ACR1099",ACRJ)
  1.  D ALPHA(ACRYR,ACRJ)
  1.  ;
  1.  D WRITE(ACRYR,ACRJ,ACRUP)
  1.  ;
  1.  Q
  1. WRITE(ACRYR,ACRJ,ACRUP)     ;
  1.  ;----- LOOP THROUGH TMP("ACR1099" FILE AND WRITE 1099s INTO FLATE FILE
  1.  ;
  1.  ;      INPUT:
  1.  ;      ACRYR   = CALENDAR YEAR
  1.  ;      ACRJ    = $JOB NUMBER
  1.  ;      ACRUP   = UPDATE FILE FLAG
  1.  ;      ^TMP("ACR1099",ACRJ IS ALREADY SET
  1.  ;
  1.  N %DEV,ZISH1,ZISH2                        ;ACR*2.1*8.08
  1.  S ZISH1=$$ARMSDIR^ACRFSYS(1)              ;ACR*2.1*8.08,ACR*2.1*13.06 IM14144
  1.  I ZISH1["alb"!(ZISH1["hqw") D             ;ACR*2.1*8.08
  1.  .S ZISH1=ZISH1_"csv/"                     ;ACR*2.1*8.08
  1.  S ZISH2="vendor"_ACRYR_".csv"             ;ACR*2.1*8.08
  1.  ;D HFS^ACRFIRSU(ZISH1,ZISH2,"W",.%DEV)    ;ACR*2.1*13.06 IM14144
  1.  D HFS^ACRFZISH(ZISH1,ZISH2,"W",.%DEV)     ;ACR*2.1*13.06 IM14144
  1.  Q:'$D(%DEV)
  1.  ;
  1.  N ACRNAME,ACRVEN,ACRCNT,ACRHDR
  1.  ;
  1.  S ACRNAME=""
  1.  S ACRCNT=0
  1.  D HDR
  1.  F  S ACRNAME=$O(^TMP("ACR1099",ACRJ,ACRNAME)) Q:ACRNAME']""  D
  1.  .S ACRVEN=0
  1.  .F  S ACRVEN=$O(^TMP("ACR1099",ACRJ,ACRNAME,ACRVEN)) Q:'ACRVEN  D
  1.  ..S ACRDATA=^TMP("ACR1099",ACRJ,ACRNAME,ACRVEN)
  1.  ..S ACRSTR=$$WRITE^ACRFIRSU(ACRDATA)
  1.  ..U %DEV
  1.  ..W ACRSTR,!
  1.  ..S ACRCNT=ACRCNT+1
  1.  ..I ACRUP=1 D UPDATE^ACRFIRSU(ACRVEN,ACRYR)
  1.  U IO(0) W !!?5,ACRCNT," records have been written into "_ZISH1_ZISH2
  1.  D CLOSE^%ZISH("FILE")
  1.  ;
  1.  Q
  1. ALPHA(ACRYR,ACRJ)       ;
  1.  ;----- BUILD ALPHABETIC ARRAY OF VENDORS IN ^TMP("ACR1099",ACRJ)
  1.  ;
  1.  ;      INPUT:
  1.  ;      ACRYR   = CALENDAR YEAR
  1.  ;      ACRJ    = $JOB NUMBER
  1.  ;  NOTE: UNPOPULATED FIELDS ARE ALLOWED AS FILE WILL BE CHECKED
  1.  ;        AFTER UPLOADING INTO COTS
  1.  ;
  1.  N ACRNAME,ACRVEN,ACRV0,ACRV11,ACRV13,Z,ACREIN,ACRVTYP
  1.  N ACRAMT,ACRCOR,ACRIRS,ACRPADD,ACRPTIN,ACRTYP,ACRVADD,ACRVTIN,DATA
  1.  S ACRVEN=0
  1.  F  S ACRVEN=$O(^ACR1099V("C",ACRYR,ACRVEN)) Q:'ACRVEN  D
  1.  . I '$D(^ACR1099V(ACRVEN,1,ACRYR)) Q
  1.  . ; START SETTING DATA STRING
  1.  . S ACRV0=$G(^AUTTVNDR(ACRVEN,0))
  1.  . S ACRV0=$$UPPER^ACRFUTL(ACRV0)
  1.  . S ACRV11=$G(^AUTTVNDR(ACRVEN,11))
  1.  . ;S ACRV13=$$UPPER^ACRFUTL(^AUTTVNDR(ACRVEN,13))  ;ACR*2.1*20.02  IM16042
  1.  . S ACRV13=$$UPPER^ACRFUTL($G(^AUTTVNDR(ACRVEN,13)))  ;ACR*2.1*20.02  IM16042
  1.  . S ACRNAME=$$NAME(ACRV0)
  1.  . S ACREIN=$P(ACRV11,U)
  1.  . S ACRTIN=$E(ACREIN,2,10)
  1.  . S ACRTYP=$E(ACREIN,1)
  1.  . S ACRADD1=$P(ACRV13,U)
  1.  . S ACRADD2=$P(ACRV13,U,10)
  1.  . S ACRCITY=$P(ACRV13,U,2)
  1.  . ;S ACRSTAB=$$STATE^ACRFIRSU($P(ACRV13,U,3))  ;ACR*2.1*20.02  IM16042
  1.  . S ACRSTAB=$P(ACRV13,U,3)                     ;ACR*2.1*20.02  IM16042
  1.  . I ACRSTAB="" S ACRSTAB=56          ;UNKNOWN  ;ACR*2.1*20.02  IM16042
  1.  . S ACRSTAB=$$STATE^ACRFIRSU(ACRSTAB)          ;ACR*2.1*20.02  IM16042
  1.  . S ACRZIP=$P(ACRV13,U,4)
  1.  . S ACRV0=$G(^ACR1099V(ACRVEN,0))
  1.  . S ACRVTYP=$P(ACRV0,U,2)
  1.  . S ACRFOR=$P(ACRV0,U,4)
  1.  . S ACRCOR=""
  1.  . I $P($G(^ACR1099V(ACRVEN,1,ACRYR,0)),U,6)="Y" S ACRCOR="X"
  1.  . S ACRAMT=$$YTD(ACRVEN,ACRYR)
  1.  . Q:ACRAMT<600
  1.  . S Z=ACRNAME                               ;1 - FULL VENDOR NAME
  1.  . S Z=Z_U_$E(ACRNAME,1,4)                   ;2 - SHORT NAME
  1.  . S Z=Z_U_ACRTIN                            ;3 - VENDOR TIN
  1.  . S Z=Z_U_ACRTYP                            ;4 - TIN TYPE
  1.  . S Z=Z_U_ACRADD1                           ;5 - ADDRESS
  1.  . S Z=Z_U_ACRADD2                           ;6 - ADDRESS 2
  1.  . S Z=Z_U_ACRCITY                           ;7 - CITY
  1.  . S Z=Z_U_ACRSTAB                           ;8 - 2 CHAR STATE
  1.  . S Z=Z_U_ACRZIP                            ;9 - ZIP
  1.  . S Z=Z_U_ACRFOR                            ;10- FOREIGN ADDRESS FLAG
  1.  . I ACRVTYP=7 S Z=Z_U_ACRAMT_U_""           ;11- CY AMT 7
  1.  . I ACRVTYP=6 S Z=Z_U_""_U_ACRAMT           ;12- CY AMT 6
  1.  . S Z=Z_U_ACRCOR                            ;13- CORRECTED FORM
  1.  . S ^TMP("ACR1099",ACRJ,ACRNAME,ACRVEN)=Z
  1.  Q
  1.  ;
  1. NAME(X) ;RETURNS VENDOR NAME
  1.  ; ---  INPUT
  1.  ;        X=DATA STRING
  1.  N Y
  1.  S Y=$P(X,U)
  1.  I $P(X,U,3)]"" S Y=$P(X,U,3)    ;NAME KNOWN TO IRS
  1.  Q Y
  1. TXT ;----- PRINT OPTION TEXT
  1.  ;
  1.  N I,X
  1.  F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END"  W !,X
  1.  Q
  1. YTD(X,Y) ;LOCAL ENTRY
  1.  ;--------------
  1.  N Z
  1.  S Z=$$YTD^ACRFIRSU(X,Y)     ;11-YEAR-TO-DATE AMOUNT(6 or 7)
  1.  I Z<600 Q 0
  1.  I Z'["." S Z=Z_".00" Q Z
  1.  I $L($P(Z,".",2))=1 S Z=Z_"0"
  1.  Q Z
  1. HDR ; SET HEADER INTO FLAT FILE
  1.  N ACRSTR
  1.  S ACRSTR="NAME"_U_"SHORT"_U_"TIN"_U_"TINTYPE"_U_"ADDRESS"
  1.  S ACRSTR=ACRSTR_U_"ADDRESS 2"_U_"CITY"_U_"STATE"_U_"ZIP"_U_"FOREIGN"
  1.  S ACRSTR=ACRSTR_U_"AMOUNT-7"_U_"AMOUNT-6"_U_"CORRECTED"
  1.  U %DEV
  1.  W $$WRITE^ACRFIRSU(ACRSTR)
  1.  W !
  1.  Q