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

ACRFIRS1.m

Go to the documentation of this file. 
  1. ACRFIRS1 ;IHS/OIRM/DSD/AEF - CREATE 1099 RECORDS FOR IRS; [ 07/20/2006   4:18 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**1,6,8,13,20**;NOV 05, 2001
  1.  ;
  1.  ;      This routine gathers vendor payment data and puts it into a 
  1.  ;      UNIX file to be transmitted to the IRS.
  1.  ;      Routine ACRFIRS2 contains the record layout formats.
  1.  ;
  1.  ;      VARIABLE LIST SET AND USED BY ACRFIRS1 AND ACRFIRS2
  1.  ;
  1.  ;      ACRAREA   =  FINANCE AREA
  1.  ;      ACRSTA    =  ANSWER IRS OR STATE
  1.  ;      ACRFSTN   =  STATE NAME
  1.  ;      ACRSTNO   =  STATE IEN
  1.  ;      ACRSTAN   =  STATE IEN THE REPORT IS FOR
  1.  ;      ACRSADR   =  VENDOR ADDRESS TYPE TO BE USED
  1.  ;      ACRZOUT   =  QUIT CONTROLLER VARIABLE
  1.  ;      ACRCNTA   =  COUNT OF A RECORDS
  1.  ;      ACRCNTB   =  COUNT OF B RECORDS
  1.  ;      ACRCNTR   =  SEQUENCE NUMBER OF RECORD ;ACR*2.1*6.01
  1.  ;      ACRVEND0  =  LOOP COUNTER IN VENDOR FILE, VENDOR IEN
  1.  ;      ACRNAME   =  VENDOR NAME
  1.  ;      ACRAMT    =  VENDOR YTD PAID AMOUNT
  1.  ;      ACRTIN    =  VENDOR TIN#
  1.  ;      ACRADD    =  VENDOR ADDRESS
  1.  ;      ACRCITY   =  VENDOR CITY
  1.  ;      ACRSTAB   =  VENDOR STATE ABBREVIATION
  1.  ;      ACRZIP    =  VENDOR ZIP CODE
  1.  ;      ACRPMYR   =  PAYMENT YEAR
  1.  ;      ACRTOT(   =  ARRAY CONTAINING PAYMENT TOTALS
  1.  ;      ACRTOTAL  =  PAYMENT GRAND TOTAL
  1.  ;      ACRAMTCD  =  PAYMENT AMOUNT TYPE CODE
  1.  ;      ACRFOR    =  FOREIGN VENDOR (1 or NULL)  ;ACR*2.1*8.05
  1.  ;
  1. EN ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  N ACRAREA,ACRFSTN,ACRPMYR,ACRSADR,ACRSTA,ACRSTAN
  1.  ;
  1.  D ^XBKVAR
  1.  D HOME^%ZIS
  1.  ;
  1.  D AREA(.ACRAREA)
  1.  Q:'$G(ACRAREA)
  1.  ;
  1.  D STATE(.ACRSTA,.ACRFSTN,.ACRSTAN)
  1.  Q:$G(ACRSTA)']""
  1.  ;
  1.  D YEAR(.ACRPMYR)
  1.  Q:'$G(ACRPMYR)
  1.  ;
  1.  D ADDRESS(.ACRSADR)
  1.  Q:$G(ACRSADR)']""
  1.  ;
  1.  D GET(ACRAREA,ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN)
  1.  ;
  1.  D UNIX(ACRFSTN)
  1.  ;
  1.  D PRINT(ACRPMYR,ACRSTA)
  1.  ;
  1.  K ^TMP("ACRZ",$J,"RECORD")
  1.  D ^%ZISC
  1.  Q
  1. GET(ACRAREA,ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN)     ;
  1.  ;----- GATHER DATA AND PUT INTO ^TMP GLOBAL
  1.  ;
  1.  ;      INPUT:
  1.  ;      ACRAREA = FINANCE AREA
  1.  ;      ACRPMYR = PAYMENT YEAR
  1.  ;      ACRSADR = VENDOR ADDRESS TYPE
  1.  ;      ACRFSTN = STATE NAME
  1.  ;      ACRSTAN = STATE IEN
  1.  ;
  1.  ;      OTHER VARIABLES USED:
  1.  ;      ACRCNTA = COUNT OF A RECORDS
  1.  ;      ACRCNTB = COUNT OF B RECORDS
  1.  ;      ACRTOT( = ARRAY CONTAINING PAYMENT TOTALS
  1.  ;
  1.  N ACRCNTA,ACRCNTB,ACRTOT,ACRCNTR  ;ACR*2.1*6.01
  1.  ;
  1.  K ^TMP("ACRZ",$J)
  1.  ;
  1.  W !,"Working..."
  1.  ;
  1.  D RECORDA^ACRFIRS2(ACRAREA,ACRPMYR,.ACRCNTA)
  1.  ;
  1.  S ACRCNTR=2               ; FIRST B RECORD WILL BE #3 ACR*2.1*6.01
  1.  D LOOP(ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN,.ACRTOT,.ACRCNTB,.ACRCNTR) ; ACR*2.1*6.06
  1.  ;
  1.  D RECORDC^ACRFIRS0(ACRAREA,.ACRTOT,ACRCNTB,.ACRCNTR) ; ACR*2.1*6.01,ACR*2.1*8.07
  1.  ;
  1.  D RECORDF^ACRFIRS0(ACRCNTA,.ACRCNTR)       ; ACR*2.1*6.01,ACR*2.1*8.07
  1.  ;
  1.  D RECORDT^ACRFIRS0(ACRAREA,ACRPMYR,ACRCNTB)          ;ACR*2.1*8.07
  1.  ;
  1.  Q
  1. LOOP(ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN,ACRTOT,ACRCNTB,ACRCNTR)       ;
  1.  ;----- LOOP THROUGH VENDOR FILE AND GATHER RECORD B DATA
  1.  ;
  1.  ;      INPUT:
  1.  ;      ACRPMYR = PAYMENT YEAR
  1.  ;      ACRSADR = VENDOR ADDRESS TYPE
  1.  ;      ACRFSTN = STATE NAME
  1.  ;      ACRSTAN = STATE IEN
  1.  ;      ACRTOT( = ARRAY CONTAINING PAYMENT TOTALS
  1.  ;      ACRCNTR = SEQUENCE RECORD NUMBER ; ACR*2.1*6.01
  1.  ;
  1.  ;      RETURNS:
  1.  ;      ACRCNTB = COUNT OF B RECORDS
  1.  ;      ACRCNTR = SEQUENCE RECORD COUNT ; ACR*2.1*6.01
  1.  ;
  1.  ;      OTHER VARIABLES USED:
  1.  ;      ACRADD   = VENDOR ADDRESS
  1.  ;      ACRAMT   = PAYMENT AMOUNT
  1.  ;      ACRAMTCD = PAYMENT AMOUNT CODE
  1.  ;      ACRCITY  = VENDOR CITY
  1.  ;      ACRNAME  = VENDOR NAME
  1.  ;      ACRSTAB  = VENDOR STATE ABBREVIATION
  1.  ;      ACRSTNO  = STATE IEN
  1.  ;      ACRTIN   = VENDOR TIN#
  1.  ;      ACRTOTAL = PAMENT GRAND TOTAL
  1.  ;      ACRVEND0 = LOOP COUNTER IN VENDOR FILE (VENDOR IEN)
  1.  ;      ACRZIP   = VENDOR ZIP CODE
  1.  ;   
  1.  ;
  1.  N ACRADD,ACRAMT,ACRAMTCD,ACRCITY,ACRNAME,ACRSTAB,ACRSTNO,ACRTIN,ACRTOTAL,ACRVEND0,ACRZIP,DATA,I
  1.  ;
  1.  K ACRTOT
  1.  ;
  1.  F I=1:1:9,"A","B","C" S ACRTOT(I)=0
  1.  ;
  1.  S (ACRVEND0,ACRCNTB,ACRTOTAL)=0
  1.  F  S ACRVEND0=$O(^ACR1099V("C",ACRPMYR,ACRVEND0)) Q:'ACRVEND0  D
  1.  . S ACRNAME=$$UPPER^ACRFUTL($P(^AUTTVNDR(ACRVEND0,0),U)) ;ACR*2.1*6.01
  1.  . Q:'$D(^AUTTVNDR(ACRVEND0,11))
  1.  . S ACRV0=$G(^ACR1099V(ACRVEND0,0)) ; ACR*2.1*8.05
  1.  . S ACRAMTCD=$P(ACRV0,U,2)          ; ACR*2.1*8.05
  1.  . S ACRFOR=$P(ACRV0,U,4)            ; ACR*2.1*8.05
  1.  . Q:ACRAMTCD=""
  1.  . S ACRAMT=+$P(^ACR1099V(ACRVEND0,1,ACRPMYR,0),U,2)
  1.  . Q:'ACRAMT
  1.  . S ACRAMT=ACRAMT*100
  1.  . Q:ACRAMT<60000
  1.  . S ACRTIN=$P($G(^AUTTVNDR(ACRVEND0,11)),U)
  1.  . Q:ACRTIN=""
  1.  . I ACRSADR="M" D
  1.  . . S DATA=$$UPPER^ACRFUTL($G(^AUTTVNDR(ACRVEND0,13)))   ;ACR*2.1*6.01
  1.  . . S ACRADD=$P(DATA,U)
  1.  . . S ACRCITY=$P(DATA,U,2)
  1.  . . S ACRSTNO=$P(DATA,U,3)
  1.  . . I ACRSTNO="" S ACRSTNO=56       ;UNKNOWN     ACR*2.1*20.02  IM16042
  1.  . . S ACRSTAB=$P($G(^DIC(5,ACRSTNO,0)),U,2)
  1.  . . S ACRZIP=$P(DATA,U,4)
  1.  . I ACRSADR="B" D
  1.  . . S DATA=$$UPPER^ACRFUTL($G(^AUTTVNDR(ACRVEND0,13)))   ;ACR*2.1*6.01
  1.  . . S ACRADD=$P(DATA,U,6)
  1.  . . S ACRCITY=$P(DATA,U,7)
  1.  . . S ACRSTNO=$P(DATA,U,8)
  1.  . . I ACRSTNO="" S ACRSTNO=56       ;UNKNOWN    ACR*2.1*20.02  IM16042
  1.  . . S ACRSTAB=$P($G(^DIC(5,ACRSTNO,0)),U,2)
  1.  . . S ACRZIP=$P(DATA,U,9)
  1.  . I ACRSADR="R" D
  1.  . . S DATA=$$UPPER^ACRFUTL($G(^AUTTVNDR(ACRVEND0,14)))   ;ACR*2.1*6.01
  1.  . . S ACRADD=$P(DATA,U)
  1.  . . S ACRCITY=$P(DATA,U,3)
  1.  . . S ACRSTNO=$P(DATA,U,4)
  1.  . . I ACRSTNO="" S ACRSTNO=56       ;UNKNOWN    ACR*2.1*20.02  IM16042
  1.  . . S ACRSTAB=$P($G(^DIC(5,ACRSTNO,0)),U,2)
  1.  . . S ACRZIP=$P(DATA,U,5)
  1.  . Q:ACRADD=""
  1.  . Q:ACRCITY=""
  1.  . Q:ACRSTAB=""
  1.  . Q:ACRZIP=""
  1.  . I ACRFSTN'="US" Q:ACRSTNO'=ACRSTAN
  1.  . S ACRTOTAL=$G(ACRTOTAL)+ACRAMT
  1.  . D RECORDB^ACRFIRS2(ACRPMYR,ACRNAME,ACRTIN,ACRVEND0,ACRAMT,ACRAMTCD,ACRADD,ACRCITY,ACRSTAB,ACRZIP,.ACRCNTB,.ACRTOT,.ACRCNTR,ACRFOR)   ;ACR*2.1*6.01,ACR*2.1*8.05
  1.  . S ^TMP("ACRZ",$J,"REPORT",ACRVEND0,0)=ACRNAME_U_$E(ACRTIN,2,10)_U_ACRAMT
  1.  S ^TMP("ACRZ",$J,"REPORT TOTAL",0)=ACRTOTAL
  1.  Q
  1. PRINT(ACRPMYR,ACRSTA)        ;
  1.  ;----- PROMPT FOR DEVICE TO PRINT REPORT TO
  1.  ;
  1.  N ACRJ,ZTSAVE
  1.  D HOME^%ZIS
  1.  S ACRJ=$J
  1.  S ZTSAVE("ACRJ")=""
  1.  S ZTSAVE("ACRPMYR")=""
  1.  S ZTSAVE("ACRSTA")=""
  1.  D QUE^ACRFUTL("DQ^ACRFIRS3",.ZTSAVE,"1099 VENDOR REPORT")
  1.  Q
  1.  ;
  1. AREA(ACRAREA)      ;
  1.  ;----- PROMPT FOR AREA
  1.  ;
  1.  ;      RETURNS:
  1.  ;      ACRAREA = FINANCE AREA
  1.  ;
  1.  N DIC,X,Y
  1.  S ACRAREA=""
  1.  S DIC="^ACR1099P("
  1.  S DIC(0)="AQZEM"
  1.  D ^DIC
  1.  K DIC
  1.  Q:+Y'>0!($D(DTOUT))!($D(DUOUT))
  1.  S ACRAREA=+Y
  1.  Q
  1.  ;
  1. STATE(ACRSTA,ACRFSTN,ACRSTAN)          ;
  1.  ;----- PROMPT FOR STATE OR IRS
  1.  ;
  1.  ;      RETURNS:
  1.  ;      ACRSTA  = ANSWER IRS OR STATE
  1.  ;      ACRFSTN = STATE NAME
  1.  ;      ACRSTAN = STATE IEN
  1.  ;
  1. STA ;----- PROMPT LOOP
  1.  ;
  1.  N DIR,X,Y
  1.  S (ACRSTA,ACRFSTN,ACRSTAN)=""
  1.  S DIR(0)="F^2:3^K:X'?.U X"
  1.  S DIR("A")="Enter 2 character State Abbreviation or 'IRS'"
  1.  S DIR("A",1)=""
  1.  S DIR("A",2)="This generates files containing 1099 records.  You must select a STATE or IRS"
  1.  S DIR("A",3)="and a file will be generated for that selection.  You may run this program"
  1.  S DIR("A",4)="as many times as necessary until all STATE files needed are created."
  1.  S DIR("A",5)=""
  1.  D ^DIR
  1.  Q:Y']""!($D(DTOUT))!($D(DUOUT))!($D(DIRUT))
  1.  S (ACRSTA,ACRFSTN)=Y
  1.  I ACRFSTN="IRS" S ACRFSTN="US" Q
  1.  S ACRSTAN=$O(^DIC(5,"C",ACRSTA,0))
  1.  I 'ACRSTAN W *7,"   NO SUCH STATE",! K ACRSTA,ACRSTAN,ACRFSTN G STA
  1.  Q
  1.  ;
  1. YEAR(ACRPMYR)      ;
  1.  ;----- PROMPT FOR YEAR
  1.  ;
  1.  ;      RETURNS:
  1.  ;      ACRPMYR = PAYMENT YEAR
  1.  ;
  1.  N DIR,X,Y
  1.  S ACRPMYR=""
  1.  S DIR(0)="N^0000:9999"
  1.  S DIR("A")="Enter Calendar Year (eg 1998)"
  1.  S DIR("B")=($E(DT,1,3)+1700)-1
  1.  D ^DIR
  1.  Q:+Y'>0!($D(DTOUT))!($D(DUOUT))!($D(DIRUT))
  1.  S ACRPMYR=Y
  1.  Q
  1.  ;
  1. ADDRESS(ACRSADR)   ;
  1.  ;----- PROMPT FOR ADDRESS TO USE
  1.  ;
  1.  ;      RETURNS:
  1.  ;      ACRSADR = VENDOR ADDRESS TYPE
  1.  ;
  1.  N DIR,X,Y
  1.  S ACRSADR=""
  1.  S DIR(0)="S^M:Mailing Address;B:Billing Address;R:Remit To Address"
  1.  S DIR("A")="Which VENDOR File Address is to be used?"
  1.  S DIR("B")="M"
  1.  D ^DIR
  1.  Q:Y']""!($D(DTOUT))!($D(DIROUT))!($D(DUOUT))
  1.  S ACRSADR=Y
  1.  Q
  1.  ;
  1.  ;
  1. UNIX(ACRSTN)       ;
  1.  ;----- WRITE ^TMP GLOBAL TO UNIX FILE
  1.  ;
  1.  N %DEV,ACRAREA,ACRDIR,ACRFILE,ACRVEND0,ACRZOUT,I,J
  1.  Q:'$D(^TMP("ACRZ",$J))
  1.  ;S ACRDIR=$$ARMSDIR^ACRFIRSU(1)      ; ACR*2.1*13.06 IM14144
  1.  S ACRDIR=$$ARMSDIR^ACRFSYS(1)        ; ACR*2.1*13.06 IM14144
  1.  I ACRDIR["alb"!(ACRDIR["hqw") D      ; ACR*2.1*8.08
  1.  .S ACRDIR=ACRDIR_"csv/"              ; ACR*2.1*8.08
  1.  D HFS(ACRDIR,ACRSTN,.ACRZOUT,.ACRFILE,.%DEV)
  1.  Q:$G(ACRZOUT)
  1.  U %DEV
  1.  F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","T",I))
  1.  S ACRAREA=0
  1.  F  S ACRAREA=$O(^TMP("ACRZ",$J,"RECORD","A",ACRAREA)) Q:'ACRAREA  D
  1.  . F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","A",ACRAREA,I))
  1.  . S ACRVEND0=0
  1.  . F  S ACRVEND0=$O(^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0)) Q:'ACRVEND0  D
  1.  . . F J=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0,J))
  1.  . F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","C",ACRAREA,I))
  1.  F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","F",I))
  1.  U 0 W !!,"Records have been put into file "_ACRDIR_ACRFILE
  1.  D CLOSE^%ZISH("FILE")
  1.  K %DEV
  1.  Q
  1. HFS(ACRDIR,ACRSTN,ACRZOUT,ACRFILE,%DEV)          ;
  1.  ;----- CREATE AND OPEN UNIX FILE
  1.  ;
  1.  N POP,X,Y
  1.  S ACRFILE="acrirs"_ACRFSTN_"."_$E(DT,1,3)_$$JDATE^ACRFUTL
  1.  D OPEN^%ZISH("FILE",ACRDIR,ACRFILE,"W")
  1.  I POP D  Q
  1.  . S ACRZOUT=1
  1.  . W !,"UNABLE TO OPEN FILE "_ACRFILE
  1.  S %DEV=IO
  1.  Q
  1.  ;
  1. NCTL(X) ;EP -- NAME CONTROL - RETURNS FIRST 4 SIGNIFICANT CHARACTERS
  1.  ;
  1.  ;      X  =  VENDOR NAME
  1.  ;
  1.  S X=$TR(X," ~!@#$%^*()_+`-={}|[]\:"""";'<>?,./","")
  1.  S X=$E(X,1,4)
  1.  Q X