ACRFIRS1 ;IHS/OIRM/DSD/AEF - CREATE 1099 RECORDS FOR IRS; [ 07/20/2006 4:18 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**1,6,8,13,20**;NOV 05, 2001
;
; This routine gathers vendor payment data and puts it into a
; UNIX file to be transmitted to the IRS.
; Routine ACRFIRS2 contains the record layout formats.
;
; VARIABLE LIST SET AND USED BY ACRFIRS1 AND ACRFIRS2
;
; ACRAREA = FINANCE AREA
; ACRSTA = ANSWER IRS OR STATE
; ACRFSTN = STATE NAME
; ACRSTNO = STATE IEN
; ACRSTAN = STATE IEN THE REPORT IS FOR
; ACRSADR = VENDOR ADDRESS TYPE TO BE USED
; ACRZOUT = QUIT CONTROLLER VARIABLE
; ACRCNTA = COUNT OF A RECORDS
; ACRCNTB = COUNT OF B RECORDS
; ACRCNTR = SEQUENCE NUMBER OF RECORD ;ACR*2.1*6.01
; ACRVEND0 = LOOP COUNTER IN VENDOR FILE, VENDOR IEN
; ACRNAME = VENDOR NAME
; ACRAMT = VENDOR YTD PAID AMOUNT
; ACRTIN = VENDOR TIN#
; ACRADD = VENDOR ADDRESS
; ACRCITY = VENDOR CITY
; ACRSTAB = VENDOR STATE ABBREVIATION
; ACRZIP = VENDOR ZIP CODE
; ACRPMYR = PAYMENT YEAR
; ACRTOT( = ARRAY CONTAINING PAYMENT TOTALS
; ACRTOTAL = PAYMENT GRAND TOTAL
; ACRAMTCD = PAYMENT AMOUNT TYPE CODE
; ACRFOR = FOREIGN VENDOR (1 or NULL) ;ACR*2.1*8.05
;
EN ;EP -- MAIN ENTRY POINT
;
N ACRAREA,ACRFSTN,ACRPMYR,ACRSADR,ACRSTA,ACRSTAN
;
D ^XBKVAR
D HOME^%ZIS
;
D AREA(.ACRAREA)
Q:'$G(ACRAREA)
;
D STATE(.ACRSTA,.ACRFSTN,.ACRSTAN)
Q:$G(ACRSTA)']""
;
D YEAR(.ACRPMYR)
Q:'$G(ACRPMYR)
;
D ADDRESS(.ACRSADR)
Q:$G(ACRSADR)']""
;
D GET(ACRAREA,ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN)
;
D UNIX(ACRFSTN)
;
D PRINT(ACRPMYR,ACRSTA)
;
K ^TMP("ACRZ",$J,"RECORD")
D ^%ZISC
Q
GET(ACRAREA,ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN) ;
;----- GATHER DATA AND PUT INTO ^TMP GLOBAL
;
; INPUT:
; ACRAREA = FINANCE AREA
; ACRPMYR = PAYMENT YEAR
; ACRSADR = VENDOR ADDRESS TYPE
; ACRFSTN = STATE NAME
; ACRSTAN = STATE IEN
;
; OTHER VARIABLES USED:
; ACRCNTA = COUNT OF A RECORDS
; ACRCNTB = COUNT OF B RECORDS
; ACRTOT( = ARRAY CONTAINING PAYMENT TOTALS
;
N ACRCNTA,ACRCNTB,ACRTOT,ACRCNTR ;ACR*2.1*6.01
;
K ^TMP("ACRZ",$J)
;
W !,"Working..."
;
D RECORDA^ACRFIRS2(ACRAREA,ACRPMYR,.ACRCNTA)
;
S ACRCNTR=2 ; FIRST B RECORD WILL BE #3 ACR*2.1*6.01
D LOOP(ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN,.ACRTOT,.ACRCNTB,.ACRCNTR) ; ACR*2.1*6.06
;
D RECORDC^ACRFIRS0(ACRAREA,.ACRTOT,ACRCNTB,.ACRCNTR) ; ACR*2.1*6.01,ACR*2.1*8.07
;
D RECORDF^ACRFIRS0(ACRCNTA,.ACRCNTR) ; ACR*2.1*6.01,ACR*2.1*8.07
;
D RECORDT^ACRFIRS0(ACRAREA,ACRPMYR,ACRCNTB) ;ACR*2.1*8.07
;
Q
LOOP(ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN,ACRTOT,ACRCNTB,ACRCNTR) ;
;----- LOOP THROUGH VENDOR FILE AND GATHER RECORD B DATA
;
; INPUT:
; ACRPMYR = PAYMENT YEAR
; ACRSADR = VENDOR ADDRESS TYPE
; ACRFSTN = STATE NAME
; ACRSTAN = STATE IEN
; ACRTOT( = ARRAY CONTAINING PAYMENT TOTALS
; ACRCNTR = SEQUENCE RECORD NUMBER ; ACR*2.1*6.01
;
; RETURNS:
; ACRCNTB = COUNT OF B RECORDS
; ACRCNTR = SEQUENCE RECORD COUNT ; ACR*2.1*6.01
;
; OTHER VARIABLES USED:
; ACRADD = VENDOR ADDRESS
; ACRAMT = PAYMENT AMOUNT
; ACRAMTCD = PAYMENT AMOUNT CODE
; ACRCITY = VENDOR CITY
; ACRNAME = VENDOR NAME
; ACRSTAB = VENDOR STATE ABBREVIATION
; ACRSTNO = STATE IEN
; ACRTIN = VENDOR TIN#
; ACRTOTAL = PAMENT GRAND TOTAL
; ACRVEND0 = LOOP COUNTER IN VENDOR FILE (VENDOR IEN)
; ACRZIP = VENDOR ZIP CODE
;
;
N ACRADD,ACRAMT,ACRAMTCD,ACRCITY,ACRNAME,ACRSTAB,ACRSTNO,ACRTIN,ACRTOTAL,ACRVEND0,ACRZIP,DATA,I
;
K ACRTOT
;
F I=1:1:9,"A","B","C" S ACRTOT(I)=0
;
S (ACRVEND0,ACRCNTB,ACRTOTAL)=0
F S ACRVEND0=$O(^ACR1099V("C",ACRPMYR,ACRVEND0)) Q:'ACRVEND0 D
. S ACRNAME=$$UPPER^ACRFUTL($P(^AUTTVNDR(ACRVEND0,0),U)) ;ACR*2.1*6.01
. Q:'$D(^AUTTVNDR(ACRVEND0,11))
. S ACRV0=$G(^ACR1099V(ACRVEND0,0)) ; ACR*2.1*8.05
. S ACRAMTCD=$P(ACRV0,U,2) ; ACR*2.1*8.05
. S ACRFOR=$P(ACRV0,U,4) ; ACR*2.1*8.05
. Q:ACRAMTCD=""
. S ACRAMT=+$P(^ACR1099V(ACRVEND0,1,ACRPMYR,0),U,2)
. Q:'ACRAMT
. S ACRAMT=ACRAMT*100
. Q:ACRAMT<60000
. S ACRTIN=$P($G(^AUTTVNDR(ACRVEND0,11)),U)
. Q:ACRTIN=""
. I ACRSADR="M" D
. . S DATA=$$UPPER^ACRFUTL($G(^AUTTVNDR(ACRVEND0,13))) ;ACR*2.1*6.01
. . S ACRADD=$P(DATA,U)
. . S ACRCITY=$P(DATA,U,2)
. . S ACRSTNO=$P(DATA,U,3)
. . I ACRSTNO="" S ACRSTNO=56 ;UNKNOWN ACR*2.1*20.02 IM16042
. . S ACRSTAB=$P($G(^DIC(5,ACRSTNO,0)),U,2)
. . S ACRZIP=$P(DATA,U,4)
. I ACRSADR="B" D
. . S DATA=$$UPPER^ACRFUTL($G(^AUTTVNDR(ACRVEND0,13))) ;ACR*2.1*6.01
. . S ACRADD=$P(DATA,U,6)
. . S ACRCITY=$P(DATA,U,7)
. . S ACRSTNO=$P(DATA,U,8)
. . I ACRSTNO="" S ACRSTNO=56 ;UNKNOWN ACR*2.1*20.02 IM16042
. . S ACRSTAB=$P($G(^DIC(5,ACRSTNO,0)),U,2)
. . S ACRZIP=$P(DATA,U,9)
. I ACRSADR="R" D
. . S DATA=$$UPPER^ACRFUTL($G(^AUTTVNDR(ACRVEND0,14))) ;ACR*2.1*6.01
. . S ACRADD=$P(DATA,U)
. . S ACRCITY=$P(DATA,U,3)
. . S ACRSTNO=$P(DATA,U,4)
. . I ACRSTNO="" S ACRSTNO=56 ;UNKNOWN ACR*2.1*20.02 IM16042
. . S ACRSTAB=$P($G(^DIC(5,ACRSTNO,0)),U,2)
. . S ACRZIP=$P(DATA,U,5)
. Q:ACRADD=""
. Q:ACRCITY=""
. Q:ACRSTAB=""
. Q:ACRZIP=""
. I ACRFSTN'="US" Q:ACRSTNO'=ACRSTAN
. S ACRTOTAL=$G(ACRTOTAL)+ACRAMT
. 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
. S ^TMP("ACRZ",$J,"REPORT",ACRVEND0,0)=ACRNAME_U_$E(ACRTIN,2,10)_U_ACRAMT
S ^TMP("ACRZ",$J,"REPORT TOTAL",0)=ACRTOTAL
Q
PRINT(ACRPMYR,ACRSTA) ;
;----- PROMPT FOR DEVICE TO PRINT REPORT TO
;
N ACRJ,ZTSAVE
D HOME^%ZIS
S ACRJ=$J
S ZTSAVE("ACRJ")=""
S ZTSAVE("ACRPMYR")=""
S ZTSAVE("ACRSTA")=""
D QUE^ACRFUTL("DQ^ACRFIRS3",.ZTSAVE,"1099 VENDOR REPORT")
Q
;
AREA(ACRAREA) ;
;----- PROMPT FOR AREA
;
; RETURNS:
; ACRAREA = FINANCE AREA
;
N DIC,X,Y
S ACRAREA=""
S DIC="^ACR1099P("
S DIC(0)="AQZEM"
D ^DIC
K DIC
Q:+Y'>0!($D(DTOUT))!($D(DUOUT))
S ACRAREA=+Y
Q
;
STATE(ACRSTA,ACRFSTN,ACRSTAN) ;
;----- PROMPT FOR STATE OR IRS
;
; RETURNS:
; ACRSTA = ANSWER IRS OR STATE
; ACRFSTN = STATE NAME
; ACRSTAN = STATE IEN
;
STA ;----- PROMPT LOOP
;
N DIR,X,Y
S (ACRSTA,ACRFSTN,ACRSTAN)=""
S DIR(0)="F^2:3^K:X'?.U X"
S DIR("A")="Enter 2 character State Abbreviation or 'IRS'"
S DIR("A",1)=""
S DIR("A",2)="This generates files containing 1099 records. You must select a STATE or IRS"
S DIR("A",3)="and a file will be generated for that selection. You may run this program"
S DIR("A",4)="as many times as necessary until all STATE files needed are created."
S DIR("A",5)=""
D ^DIR
Q:Y']""!($D(DTOUT))!($D(DUOUT))!($D(DIRUT))
S (ACRSTA,ACRFSTN)=Y
I ACRFSTN="IRS" S ACRFSTN="US" Q
S ACRSTAN=$O(^DIC(5,"C",ACRSTA,0))
I 'ACRSTAN W *7," NO SUCH STATE",! K ACRSTA,ACRSTAN,ACRFSTN G STA
Q
;
YEAR(ACRPMYR) ;
;----- PROMPT FOR YEAR
;
; RETURNS:
; ACRPMYR = PAYMENT YEAR
;
N DIR,X,Y
S ACRPMYR=""
S DIR(0)="N^0000:9999"
S DIR("A")="Enter Calendar Year (eg 1998)"
S DIR("B")=($E(DT,1,3)+1700)-1
D ^DIR
Q:+Y'>0!($D(DTOUT))!($D(DUOUT))!($D(DIRUT))
S ACRPMYR=Y
Q
;
ADDRESS(ACRSADR) ;
;----- PROMPT FOR ADDRESS TO USE
;
; RETURNS:
; ACRSADR = VENDOR ADDRESS TYPE
;
N DIR,X,Y
S ACRSADR=""
S DIR(0)="S^M:Mailing Address;B:Billing Address;R:Remit To Address"
S DIR("A")="Which VENDOR File Address is to be used?"
S DIR("B")="M"
D ^DIR
Q:Y']""!($D(DTOUT))!($D(DIROUT))!($D(DUOUT))
S ACRSADR=Y
Q
;
;
UNIX(ACRSTN) ;
;----- WRITE ^TMP GLOBAL TO UNIX FILE
;
N %DEV,ACRAREA,ACRDIR,ACRFILE,ACRVEND0,ACRZOUT,I,J
Q:'$D(^TMP("ACRZ",$J))
;S ACRDIR=$$ARMSDIR^ACRFIRSU(1) ; ACR*2.1*13.06 IM14144
S ACRDIR=$$ARMSDIR^ACRFSYS(1) ; ACR*2.1*13.06 IM14144
I ACRDIR["alb"!(ACRDIR["hqw") D ; ACR*2.1*8.08
.S ACRDIR=ACRDIR_"csv/" ; ACR*2.1*8.08
D HFS(ACRDIR,ACRSTN,.ACRZOUT,.ACRFILE,.%DEV)
Q:$G(ACRZOUT)
U %DEV
F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","T",I))
S ACRAREA=0
F S ACRAREA=$O(^TMP("ACRZ",$J,"RECORD","A",ACRAREA)) Q:'ACRAREA D
. F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","A",ACRAREA,I))
. S ACRVEND0=0
. F S ACRVEND0=$O(^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0)) Q:'ACRVEND0 D
. . F J=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0,J))
. F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","C",ACRAREA,I))
F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","F",I))
U 0 W !!,"Records have been put into file "_ACRDIR_ACRFILE
D CLOSE^%ZISH("FILE")
K %DEV
Q
HFS(ACRDIR,ACRSTN,ACRZOUT,ACRFILE,%DEV) ;
;----- CREATE AND OPEN UNIX FILE
;
N POP,X,Y
S ACRFILE="acrirs"_ACRFSTN_"."_$E(DT,1,3)_$$JDATE^ACRFUTL
D OPEN^%ZISH("FILE",ACRDIR,ACRFILE,"W")
I POP D Q
. S ACRZOUT=1
. W !,"UNABLE TO OPEN FILE "_ACRFILE
S %DEV=IO
Q
;
NCTL(X) ;EP -- NAME CONTROL - RETURNS FIRST 4 SIGNIFICANT CHARACTERS
;
; X = VENDOR NAME
;
S X=$TR(X," ~!@#$%^*()_+`-={}|[]\:"""";'<>?,./","")
S X=$E(X,1,4)
Q X
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
+2 ;
+3 ; This routine gathers vendor payment data and puts it into a
+4 ; UNIX file to be transmitted to the IRS.
+5 ; Routine ACRFIRS2 contains the record layout formats.
+6 ;
+7 ; VARIABLE LIST SET AND USED BY ACRFIRS1 AND ACRFIRS2
+8 ;
+9 ; ACRAREA = FINANCE AREA
+10 ; ACRSTA = ANSWER IRS OR STATE
+11 ; ACRFSTN = STATE NAME
+12 ; ACRSTNO = STATE IEN
+13 ; ACRSTAN = STATE IEN THE REPORT IS FOR
+14 ; ACRSADR = VENDOR ADDRESS TYPE TO BE USED
+15 ; ACRZOUT = QUIT CONTROLLER VARIABLE
+16 ; ACRCNTA = COUNT OF A RECORDS
+17 ; ACRCNTB = COUNT OF B RECORDS
+18 ; ACRCNTR = SEQUENCE NUMBER OF RECORD ;ACR*2.1*6.01
+19 ; ACRVEND0 = LOOP COUNTER IN VENDOR FILE, VENDOR IEN
+20 ; ACRNAME = VENDOR NAME
+21 ; ACRAMT = VENDOR YTD PAID AMOUNT
+22 ; ACRTIN = VENDOR TIN#
+23 ; ACRADD = VENDOR ADDRESS
+24 ; ACRCITY = VENDOR CITY
+25 ; ACRSTAB = VENDOR STATE ABBREVIATION
+26 ; ACRZIP = VENDOR ZIP CODE
+27 ; ACRPMYR = PAYMENT YEAR
+28 ; ACRTOT( = ARRAY CONTAINING PAYMENT TOTALS
+29 ; ACRTOTAL = PAYMENT GRAND TOTAL
+30 ; ACRAMTCD = PAYMENT AMOUNT TYPE CODE
+31 ; ACRFOR = FOREIGN VENDOR (1 or NULL) ;ACR*2.1*8.05
+32 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW ACRAREA,ACRFSTN,ACRPMYR,ACRSADR,ACRSTA,ACRSTAN
+3 ;
+4 DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;
+7 DO AREA(.ACRAREA)
+8 IF '$GET(ACRAREA)
QUIT
+9 ;
+10 DO STATE(.ACRSTA,.ACRFSTN,.ACRSTAN)
+11 IF $GET(ACRSTA)']""
QUIT
+12 ;
+13 DO YEAR(.ACRPMYR)
+14 IF '$GET(ACRPMYR)
QUIT
+15 ;
+16 DO ADDRESS(.ACRSADR)
+17 IF $GET(ACRSADR)']""
QUIT
+18 ;
+19 DO GET(ACRAREA,ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN)
+20 ;
+21 DO UNIX(ACRFSTN)
+22 ;
+23 DO PRINT(ACRPMYR,ACRSTA)
+24 ;
+25 KILL ^TMP("ACRZ",$JOB,"RECORD")
+26 DO ^%ZISC
+27 QUIT
GET(ACRAREA,ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN) ;
+1 ;----- GATHER DATA AND PUT INTO ^TMP GLOBAL
+2 ;
+3 ; INPUT:
+4 ; ACRAREA = FINANCE AREA
+5 ; ACRPMYR = PAYMENT YEAR
+6 ; ACRSADR = VENDOR ADDRESS TYPE
+7 ; ACRFSTN = STATE NAME
+8 ; ACRSTAN = STATE IEN
+9 ;
+10 ; OTHER VARIABLES USED:
+11 ; ACRCNTA = COUNT OF A RECORDS
+12 ; ACRCNTB = COUNT OF B RECORDS
+13 ; ACRTOT( = ARRAY CONTAINING PAYMENT TOTALS
+14 ;
+15 ;ACR*2.1*6.01
NEW ACRCNTA,ACRCNTB,ACRTOT,ACRCNTR
+16 ;
+17 KILL ^TMP("ACRZ",$JOB)
+18 ;
+19 WRITE !,"Working..."
+20 ;
+21 DO RECORDA^ACRFIRS2(ACRAREA,ACRPMYR,.ACRCNTA)
+22 ;
+23 ; FIRST B RECORD WILL BE #3 ACR*2.1*6.01
SET ACRCNTR=2
+24 ; ACR*2.1*6.06
DO LOOP(ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN,.ACRTOT,.ACRCNTB,.ACRCNTR)
+25 ;
+26 ; ACR*2.1*6.01,ACR*2.1*8.07
DO RECORDC^ACRFIRS0(ACRAREA,.ACRTOT,ACRCNTB,.ACRCNTR)
+27 ;
+28 ; ACR*2.1*6.01,ACR*2.1*8.07
DO RECORDF^ACRFIRS0(ACRCNTA,.ACRCNTR)
+29 ;
+30 ;ACR*2.1*8.07
DO RECORDT^ACRFIRS0(ACRAREA,ACRPMYR,ACRCNTB)
+31 ;
+32 QUIT
LOOP(ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN,ACRTOT,ACRCNTB,ACRCNTR) ;
+1 ;----- LOOP THROUGH VENDOR FILE AND GATHER RECORD B DATA
+2 ;
+3 ; INPUT:
+4 ; ACRPMYR = PAYMENT YEAR
+5 ; ACRSADR = VENDOR ADDRESS TYPE
+6 ; ACRFSTN = STATE NAME
+7 ; ACRSTAN = STATE IEN
+8 ; ACRTOT( = ARRAY CONTAINING PAYMENT TOTALS
+9 ; ACRCNTR = SEQUENCE RECORD NUMBER ; ACR*2.1*6.01
+10 ;
+11 ; RETURNS:
+12 ; ACRCNTB = COUNT OF B RECORDS
+13 ; ACRCNTR = SEQUENCE RECORD COUNT ; ACR*2.1*6.01
+14 ;
+15 ; OTHER VARIABLES USED:
+16 ; ACRADD = VENDOR ADDRESS
+17 ; ACRAMT = PAYMENT AMOUNT
+18 ; ACRAMTCD = PAYMENT AMOUNT CODE
+19 ; ACRCITY = VENDOR CITY
+20 ; ACRNAME = VENDOR NAME
+21 ; ACRSTAB = VENDOR STATE ABBREVIATION
+22 ; ACRSTNO = STATE IEN
+23 ; ACRTIN = VENDOR TIN#
+24 ; ACRTOTAL = PAMENT GRAND TOTAL
+25 ; ACRVEND0 = LOOP COUNTER IN VENDOR FILE (VENDOR IEN)
+26 ; ACRZIP = VENDOR ZIP CODE
+27 ;
+28 ;
+29 NEW ACRADD,ACRAMT,ACRAMTCD,ACRCITY,ACRNAME,ACRSTAB,ACRSTNO,ACRTIN,ACRTOTAL,ACRVEND0,ACRZIP,DATA,I
+30 ;
+31 KILL ACRTOT
+32 ;
+33 FOR I=1:1:9,"A","B","C"
SET ACRTOT(I)=0
+34 ;
+35 SET (ACRVEND0,ACRCNTB,ACRTOTAL)=0
+36 FOR
SET ACRVEND0=$ORDER(^ACR1099V("C",ACRPMYR,ACRVEND0))
IF 'ACRVEND0
QUIT
Begin DoDot:1
+37 ;ACR*2.1*6.01
SET ACRNAME=$$UPPER^ACRFUTL($PIECE(^AUTTVNDR(ACRVEND0,0),U))
+38 IF '$DATA(^AUTTVNDR(ACRVEND0,11))
QUIT
+39 ; ACR*2.1*8.05
SET ACRV0=$GET(^ACR1099V(ACRVEND0,0))
+40 ; ACR*2.1*8.05
SET ACRAMTCD=$PIECE(ACRV0,U,2)
+41 ; ACR*2.1*8.05
SET ACRFOR=$PIECE(ACRV0,U,4)
+42 IF ACRAMTCD=""
QUIT
+43 SET ACRAMT=+$PIECE(^ACR1099V(ACRVEND0,1,ACRPMYR,0),U,2)
+44 IF 'ACRAMT
QUIT
+45 SET ACRAMT=ACRAMT*100
+46 IF ACRAMT<60000
QUIT
+47 SET ACRTIN=$PIECE($GET(^AUTTVNDR(ACRVEND0,11)),U)
+48 IF ACRTIN=""
QUIT
+49 IF ACRSADR="M"
Begin DoDot:2
+50 ;ACR*2.1*6.01
SET DATA=$$UPPER^ACRFUTL($GET(^AUTTVNDR(ACRVEND0,13)))
+51 SET ACRADD=$PIECE(DATA,U)
+52 SET ACRCITY=$PIECE(DATA,U,2)
+53 SET ACRSTNO=$PIECE(DATA,U,3)
+54 ;UNKNOWN ACR*2.1*20.02 IM16042
IF ACRSTNO=""
SET ACRSTNO=56
+55 SET ACRSTAB=$PIECE($GET(^DIC(5,ACRSTNO,0)),U,2)
+56 SET ACRZIP=$PIECE(DATA,U,4)
End DoDot:2
+57 IF ACRSADR="B"
Begin DoDot:2
+58 ;ACR*2.1*6.01
SET DATA=$$UPPER^ACRFUTL($GET(^AUTTVNDR(ACRVEND0,13)))
+59 SET ACRADD=$PIECE(DATA,U,6)
+60 SET ACRCITY=$PIECE(DATA,U,7)
+61 SET ACRSTNO=$PIECE(DATA,U,8)
+62 ;UNKNOWN ACR*2.1*20.02 IM16042
IF ACRSTNO=""
SET ACRSTNO=56
+63 SET ACRSTAB=$PIECE($GET(^DIC(5,ACRSTNO,0)),U,2)
+64 SET ACRZIP=$PIECE(DATA,U,9)
End DoDot:2
+65 IF ACRSADR="R"
Begin DoDot:2
+66 ;ACR*2.1*6.01
SET DATA=$$UPPER^ACRFUTL($GET(^AUTTVNDR(ACRVEND0,14)))
+67 SET ACRADD=$PIECE(DATA,U)
+68 SET ACRCITY=$PIECE(DATA,U,3)
+69 SET ACRSTNO=$PIECE(DATA,U,4)
+70 ;UNKNOWN ACR*2.1*20.02 IM16042
IF ACRSTNO=""
SET ACRSTNO=56
+71 SET ACRSTAB=$PIECE($GET(^DIC(5,ACRSTNO,0)),U,2)
+72 SET ACRZIP=$PIECE(DATA,U,5)
End DoDot:2
+73 IF ACRADD=""
QUIT
+74 IF ACRCITY=""
QUIT
+75 IF ACRSTAB=""
QUIT
+76 IF ACRZIP=""
QUIT
+77 IF ACRFSTN'="US"
IF ACRSTNO'=ACRSTAN
QUIT
+78 SET ACRTOTAL=$GET(ACRTOTAL)+ACRAMT
+79 ;ACR*2.1*6.01,ACR*2.1*8.05
DO RECORDB^ACRFIRS2(ACRPMYR,ACRNAME,ACRTIN,ACRVEND0,ACRAMT,ACRAMTCD,ACRADD,ACRCITY,ACRSTAB,ACRZIP,.ACRCNTB,.ACRTOT,.ACRCNTR,ACRFOR)
+80 SET ^TMP("ACRZ",$JOB,"REPORT",ACRVEND0,0)=ACRNAME_U_$EXTRACT(ACRTIN,2,10)_U_ACRAMT
End DoDot:1
+81 SET ^TMP("ACRZ",$JOB,"REPORT TOTAL",0)=ACRTOTAL
+82 QUIT
PRINT(ACRPMYR,ACRSTA) ;
+1 ;----- PROMPT FOR DEVICE TO PRINT REPORT TO
+2 ;
+3 NEW ACRJ,ZTSAVE
+4 DO HOME^%ZIS
+5 SET ACRJ=$JOB
+6 SET ZTSAVE("ACRJ")=""
+7 SET ZTSAVE("ACRPMYR")=""
+8 SET ZTSAVE("ACRSTA")=""
+9 DO QUE^ACRFUTL("DQ^ACRFIRS3",.ZTSAVE,"1099 VENDOR REPORT")
+10 QUIT
+11 ;
AREA(ACRAREA) ;
+1 ;----- PROMPT FOR AREA
+2 ;
+3 ; RETURNS:
+4 ; ACRAREA = FINANCE AREA
+5 ;
+6 NEW DIC,X,Y
+7 SET ACRAREA=""
+8 SET DIC="^ACR1099P("
+9 SET DIC(0)="AQZEM"
+10 DO ^DIC
+11 KILL DIC
+12 IF +Y'>0!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+13 SET ACRAREA=+Y
+14 QUIT
+15 ;
STATE(ACRSTA,ACRFSTN,ACRSTAN) ;
+1 ;----- PROMPT FOR STATE OR IRS
+2 ;
+3 ; RETURNS:
+4 ; ACRSTA = ANSWER IRS OR STATE
+5 ; ACRFSTN = STATE NAME
+6 ; ACRSTAN = STATE IEN
+7 ;
STA ;----- PROMPT LOOP
+1 ;
+2 NEW DIR,X,Y
+3 SET (ACRSTA,ACRFSTN,ACRSTAN)=""
+4 SET DIR(0)="F^2:3^K:X'?.U X"
+5 SET DIR("A")="Enter 2 character State Abbreviation or 'IRS'"
+6 SET DIR("A",1)=""
+7 SET DIR("A",2)="This generates files containing 1099 records. You must select a STATE or IRS"
+8 SET DIR("A",3)="and a file will be generated for that selection. You may run this program"
+9 SET DIR("A",4)="as many times as necessary until all STATE files needed are created."
+10 SET DIR("A",5)=""
+11 DO ^DIR
+12 IF Y']""!($DATA(DTOUT))!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+13 SET (ACRSTA,ACRFSTN)=Y
+14 IF ACRFSTN="IRS"
SET ACRFSTN="US"
QUIT
+15 SET ACRSTAN=$ORDER(^DIC(5,"C",ACRSTA,0))
+16 IF 'ACRSTAN
WRITE *7," NO SUCH STATE",!
KILL ACRSTA,ACRSTAN,ACRFSTN
GOTO STA
+17 QUIT
+18 ;
YEAR(ACRPMYR) ;
+1 ;----- PROMPT FOR YEAR
+2 ;
+3 ; RETURNS:
+4 ; ACRPMYR = PAYMENT YEAR
+5 ;
+6 NEW DIR,X,Y
+7 SET ACRPMYR=""
+8 SET DIR(0)="N^0000:9999"
+9 SET DIR("A")="Enter Calendar Year (eg 1998)"
+10 SET DIR("B")=($EXTRACT(DT,1,3)+1700)-1
+11 DO ^DIR
+12 IF +Y'>0!($DATA(DTOUT))!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+13 SET ACRPMYR=Y
+14 QUIT
+15 ;
ADDRESS(ACRSADR) ;
+1 ;----- PROMPT FOR ADDRESS TO USE
+2 ;
+3 ; RETURNS:
+4 ; ACRSADR = VENDOR ADDRESS TYPE
+5 ;
+6 NEW DIR,X,Y
+7 SET ACRSADR=""
+8 SET DIR(0)="S^M:Mailing Address;B:Billing Address;R:Remit To Address"
+9 SET DIR("A")="Which VENDOR File Address is to be used?"
+10 SET DIR("B")="M"
+11 DO ^DIR
+12 IF Y']""!($DATA(DTOUT))!($DATA(DIROUT))!($DATA(DUOUT))
QUIT
+13 SET ACRSADR=Y
+14 QUIT
+15 ;
+16 ;
UNIX(ACRSTN) ;
+1 ;----- WRITE ^TMP GLOBAL TO UNIX FILE
+2 ;
+3 NEW %DEV,ACRAREA,ACRDIR,ACRFILE,ACRVEND0,ACRZOUT,I,J
+4 IF '$DATA(^TMP("ACRZ",$JOB))
QUIT
+5 ;S ACRDIR=$$ARMSDIR^ACRFIRSU(1) ; ACR*2.1*13.06 IM14144
+6 ; ACR*2.1*13.06 IM14144
SET ACRDIR=$$ARMSDIR^ACRFSYS(1)
+7 ; ACR*2.1*8.08
IF ACRDIR["alb"!(ACRDIR["hqw")
Begin DoDot:1
+8 ; ACR*2.1*8.08
SET ACRDIR=ACRDIR_"csv/"
End DoDot:1
+9 DO HFS(ACRDIR,ACRSTN,.ACRZOUT,.ACRFILE,.%DEV)
+10 IF $GET(ACRZOUT)
QUIT
+11 USE %DEV
+12 FOR I=1:1:4
WRITE $GET(^TMP("ACRZ",$JOB,"RECORD","T",I))
+13 SET ACRAREA=0
+14 FOR
SET ACRAREA=$ORDER(^TMP("ACRZ",$JOB,"RECORD","A",ACRAREA))
IF 'ACRAREA
QUIT
Begin DoDot:1
+15 FOR I=1:1:4
WRITE $GET(^TMP("ACRZ",$JOB,"RECORD","A",ACRAREA,I))
+16 SET ACRVEND0=0
+17 FOR
SET ACRVEND0=$ORDER(^TMP("ACRZ",$JOB,"RECORD","B",ACRAREA,ACRVEND0))
IF 'ACRVEND0
QUIT
Begin DoDot:2
+18 FOR J=1:1:4
WRITE $GET(^TMP("ACRZ",$JOB,"RECORD","B",ACRAREA,ACRVEND0,J))
End DoDot:2
+19 FOR I=1:1:4
WRITE $GET(^TMP("ACRZ",$JOB,"RECORD","C",ACRAREA,I))
End DoDot:1
+20 FOR I=1:1:4
WRITE $GET(^TMP("ACRZ",$JOB,"RECORD","F",I))
+21 USE 0
WRITE !!,"Records have been put into file "_ACRDIR_ACRFILE
+22 DO CLOSE^%ZISH("FILE")
+23 KILL %DEV
+24 QUIT
HFS(ACRDIR,ACRSTN,ACRZOUT,ACRFILE,%DEV) ;
+1 ;----- CREATE AND OPEN UNIX FILE
+2 ;
+3 NEW POP,X,Y
+4 SET ACRFILE="acrirs"_ACRFSTN_"."_$EXTRACT(DT,1,3)_$$JDATE^ACRFUTL
+5 DO OPEN^%ZISH("FILE",ACRDIR,ACRFILE,"W")
+6 IF POP
Begin DoDot:1
+7 SET ACRZOUT=1
+8 WRITE !,"UNABLE TO OPEN FILE "_ACRFILE
End DoDot:1
QUIT
+9 SET %DEV=IO
+10 QUIT
+11 ;
NCTL(X) ;EP -- NAME CONTROL - RETURNS FIRST 4 SIGNIFICANT CHARACTERS
+1 ;
+2 ; X = VENDOR NAME
+3 ;
+4 SET X=$TRANSLATE(X," ~!@#$%^*()_+`-={}|[]\:"""";'<>?,./","")
+5 SET X=$EXTRACT(X,1,4)
+6 QUIT X
