KIDS Distribution saved on Jan 16, 2002@09:01:14
ARMS PATCH ACR*2.1*1
**KIDS**:ACR*2.1*1^

**INSTALL NAME**
ACR*2.1*1
"BLD",360,0)
ACR*2.1*1^ADMIN RESOURCE MGT SYSTEM^0^3020111^n
"BLD",360,1,0)
^^31^31^3020111^
"BLD",360,1,1,0)
This patch makes the following changes:
"BLD",360,1,2,0)
 
"BLD",360,1,3,0)
1. Nine new fields are added to the "T" record for the electronically
"BLD",360,1,4,0)
submitted 1099.
"BLD",360,1,5,0)
 
"BLD",360,1,6,0)
   The new fields are:
"BLD",360,1,7,0)
 
"BLD",360,1,8,0)
   VENDOR INDICATOR (MANDATORY)  (pos 376-376)
"BLD",360,1,9,0)
   I = Software developed by inhouse programmer
"BLD",360,1,10,0)
   V = Software purchased from outside vendor
"BLD",360,1,11,0)
 
"BLD",360,1,12,0)
   The rest of these fields are mandatory ONLY if using software bought
"BLD",360,1,13,0)
   from an outside vendor:
"BLD",360,1,14,0)
   VENDOR NAME                   (pos 377-416)
"BLD",360,1,15,0)
   VENDOR MAILING ADDRESS        (pos 417-456)
"BLD",360,1,16,0)
   VENDOR CITY                   (pos 457-496)
"BLD",360,1,17,0)
   VENDOR STATE                  (pos 497-498)
"BLD",360,1,18,0)
   VENDOR ZIP CODE               (pos 499-507)
"BLD",360,1,19,0)
 
"BLD",360,1,20,0)
AZHQ SOFTWARE MODIFICATIONS LIST               JAN 11,2002  15:22    PAGE
"BLD",360,1,21,0)
2
"BLD",360,1,22,0)
DESCRIPTION OF PROBLEM
"BLD",360,1,23,0)
--------------------------------------------------------------------------
"BLD",360,1,24,0)
------
"BLD",360,1,25,0)
 
"BLD",360,1,26,0)
   VENDOR CONTACT NAME           (pos 508-547)
"BLD",360,1,27,0)
   VENDOR CONTACT PHONE          (pos 548-562)
"BLD",360,1,28,0)
   VENDOR CONTACT EMAIL          (pos 563-582)
"BLD",360,1,29,0)
 
"BLD",360,1,30,0)
2. The format of the paper 1099 forms has been changed. Modifications are
"BLD",360,1,31,0)
made to print the 1099 data onto the new 1099 forms.    
"BLD",360,4,0)
^9.64PA^^
"BLD",360,"ABPKG")
n
"BLD",360,"KRN",0)
^9.67PA^19^18
"BLD",360,"KRN",.4,0)
.4
"BLD",360,"KRN",.401,0)
.401
"BLD",360,"KRN",.402,0)
.402
"BLD",360,"KRN",.403,0)
.403
"BLD",360,"KRN",.5,0)
.5
"BLD",360,"KRN",.84,0)
.84
"BLD",360,"KRN",3.6,0)
3.6
"BLD",360,"KRN",3.8,0)
3.8
"BLD",360,"KRN",9.2,0)
9.2
"BLD",360,"KRN",9.8,0)
9.8
"BLD",360,"KRN",9.8,"NM",0)
^9.68A^4^4
"BLD",360,"KRN",9.8,"NM",1,0)
ACRFIRS1^^0^B64329628
"BLD",360,"KRN",9.8,"NM",2,0)
ACRFIRS2^^0^B84358542
"BLD",360,"KRN",9.8,"NM",3,0)
ACRFIRS6^^0^B148910949
"BLD",360,"KRN",9.8,"NM",4,0)
ACRF211E^^0^B1398982
"BLD",360,"KRN",9.8,"NM","B","ACRF211E",4)

"BLD",360,"KRN",9.8,"NM","B","ACRFIRS1",1)

"BLD",360,"KRN",9.8,"NM","B","ACRFIRS2",2)

"BLD",360,"KRN",9.8,"NM","B","ACRFIRS6",3)

"BLD",360,"KRN",19,0)
19
"BLD",360,"KRN",19.1,0)
19.1
"BLD",360,"KRN",101,0)
101
"BLD",360,"KRN",409.61,0)
409.61
"BLD",360,"KRN",771,0)
771
"BLD",360,"KRN",869.2,0)
869.2
"BLD",360,"KRN",870,0)
870
"BLD",360,"KRN",8994,0)
8994
"BLD",360,"KRN","B",.4,.4)

"BLD",360,"KRN","B",.401,.401)

"BLD",360,"KRN","B",.402,.402)

"BLD",360,"KRN","B",.403,.403)

"BLD",360,"KRN","B",.5,.5)

"BLD",360,"KRN","B",.84,.84)

"BLD",360,"KRN","B",3.6,3.6)

"BLD",360,"KRN","B",3.8,3.8)

"BLD",360,"KRN","B",9.2,9.2)

"BLD",360,"KRN","B",9.8,9.8)

"BLD",360,"KRN","B",19,19)

"BLD",360,"KRN","B",19.1,19.1)

"BLD",360,"KRN","B",101,101)

"BLD",360,"KRN","B",409.61,409.61)

"BLD",360,"KRN","B",771,771)

"BLD",360,"KRN","B",869.2,869.2)

"BLD",360,"KRN","B",870,870)

"BLD",360,"KRN","B",8994,8994)

"BLD",360,"PRE")
ACRF211E
"BLD",360,"QUES",0)
^9.62^^
"PKG",343,-1)
1^1
"PKG",343,0)
ADMIN RESOURCE MGT SYSTEM^ACR^ADMIN RESOURCE MGT SYSTEM
"PKG",343,20,0)
^9.402P^^
"PKG",343,22,0)
^9.49I^1^1
"PKG",343,22,1,0)
2.1^3011105^3011101^345
"PKG",343,22,1,"PAH",1,0)
1^3020111^345
"PKG",343,22,1,"PAH",1,1,0)
^^31^31^3020116
"PKG",343,22,1,"PAH",1,1,1,0)
This patch makes the following changes:
"PKG",343,22,1,"PAH",1,1,2,0)
 
"PKG",343,22,1,"PAH",1,1,3,0)
1. Nine new fields are added to the "T" record for the electronically
"PKG",343,22,1,"PAH",1,1,4,0)
submitted 1099.
"PKG",343,22,1,"PAH",1,1,5,0)
 
"PKG",343,22,1,"PAH",1,1,6,0)
   The new fields are:
"PKG",343,22,1,"PAH",1,1,7,0)
 
"PKG",343,22,1,"PAH",1,1,8,0)
   VENDOR INDICATOR (MANDATORY)  (pos 376-376)
"PKG",343,22,1,"PAH",1,1,9,0)
   I = Software developed by inhouse programmer
"PKG",343,22,1,"PAH",1,1,10,0)
   V = Software purchased from outside vendor
"PKG",343,22,1,"PAH",1,1,11,0)
 
"PKG",343,22,1,"PAH",1,1,12,0)
   The rest of these fields are mandatory ONLY if using software bought
"PKG",343,22,1,"PAH",1,1,13,0)
   from an outside vendor:
"PKG",343,22,1,"PAH",1,1,14,0)
   VENDOR NAME                   (pos 377-416)
"PKG",343,22,1,"PAH",1,1,15,0)
   VENDOR MAILING ADDRESS        (pos 417-456)
"PKG",343,22,1,"PAH",1,1,16,0)
   VENDOR CITY                   (pos 457-496)
"PKG",343,22,1,"PAH",1,1,17,0)
   VENDOR STATE                  (pos 497-498)
"PKG",343,22,1,"PAH",1,1,18,0)
   VENDOR ZIP CODE               (pos 499-507)
"PKG",343,22,1,"PAH",1,1,19,0)
 
"PKG",343,22,1,"PAH",1,1,20,0)
AZHQ SOFTWARE MODIFICATIONS LIST               JAN 11,2002  15:22    PAGE
"PKG",343,22,1,"PAH",1,1,21,0)
2
"PKG",343,22,1,"PAH",1,1,22,0)
DESCRIPTION OF PROBLEM
"PKG",343,22,1,"PAH",1,1,23,0)
--------------------------------------------------------------------------
"PKG",343,22,1,"PAH",1,1,24,0)
------
"PKG",343,22,1,"PAH",1,1,25,0)
 
"PKG",343,22,1,"PAH",1,1,26,0)
   VENDOR CONTACT NAME           (pos 508-547)
"PKG",343,22,1,"PAH",1,1,27,0)
   VENDOR CONTACT PHONE          (pos 548-562)
"PKG",343,22,1,"PAH",1,1,28,0)
   VENDOR CONTACT EMAIL          (pos 563-582)
"PKG",343,22,1,"PAH",1,1,29,0)
 
"PKG",343,22,1,"PAH",1,1,30,0)
2. The format of the paper 1099 forms has been changed. Modifications are
"PKG",343,22,1,"PAH",1,1,31,0)
made to print the 1099 data onto the new 1099 forms.    
"PRE")
ACRF211E
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
YES
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
YES
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
4
"RTN","ACRF211E")
0^4^B1398982
"RTN","ACRF211E",1,0)
ACRF211E ;IHS/OIRM/DSD/AEF - PATCH 1 ENVIRONMENT CHECK ROUTINE [ 01/16/2002  9:00 AM ]
"RTN","ACRF211E",2,0)
 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**1**;JAN 11, 2002
"RTN","ACRF211E",3,0)
 ;
"RTN","ACRF211E",4,0)
EN ;EP -- MAIN ENTRY POINT
"RTN","ACRF211E",5,0)
 ;
"RTN","ACRF211E",6,0)
 ;      DETERMINES IF CORRECT VERSION NUMBER EXISTS
"RTN","ACRF211E",7,0)
 ;      
"RTN","ACRF211E",8,0)
 N X,Y
"RTN","ACRF211E",9,0)
 S Y=$$VERSION^XPDUTL("ADMIN RESOURCE MGT SYSTEM")
"RTN","ACRF211E",10,0)
 I Y'=$$VER^XPDUTL("ACR*2.1*1") D  Q
"RTN","ACRF211E",11,0)
 . S XPDQUIT=1
"RTN","ACRF211E",12,0)
 . S X="This patch is for ARMS version "_$$VER^XPDUTL("ACR*2.1*1")_" but you are running version "_Y_"."
"RTN","ACRF211E",13,0)
 . D BMES^XPDUTL(X)
"RTN","ACRF211E",14,0)
 . D BMES^XPDUTL("This patch cannot be installed on your system.")
"RTN","ACRF211E",15,0)
 ;
"RTN","ACRF211E",16,0)
 D BMES^XPDUTL("Everything looks OK, you may continue with installation.")
"RTN","ACRF211E",17,0)
 Q
"RTN","ACRFIRS1")
0^1^B64329628
"RTN","ACRFIRS1",1,0)
ACRFIRS1 ;IHS/OIRM/DSD/AEF - CREATE 1099 RECORDS FOR IRS; [ 01/15/2002  6:05 PM ]
"RTN","ACRFIRS1",2,0)
 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**1**;NOV 05, 2001
"RTN","ACRFIRS1",3,0)
 ;
"RTN","ACRFIRS1",4,0)
 ;
"RTN","ACRFIRS1",5,0)
 ;      This routine gathers vendor payment data and puts it into a 
"RTN","ACRFIRS1",6,0)
 ;      UNIX file to be transmitted to the IRS.
"RTN","ACRFIRS1",7,0)
 ;      Routine ACRFIRS2 contains the record layout formats.
"RTN","ACRFIRS1",8,0)
 ;
"RTN","ACRFIRS1",9,0)
 ;      VARIABLE LIST SET AND USED BY ACRFIRS1 AND ACRFIRS2
"RTN","ACRFIRS1",10,0)
 ;
"RTN","ACRFIRS1",11,0)
 ;      ACRAREA   =  FINANCE AREA
"RTN","ACRFIRS1",12,0)
 ;      ACRSTA    =  ANSWER IRS OR STATE
"RTN","ACRFIRS1",13,0)
 ;      ACRFSTN   =  STATE NAME
"RTN","ACRFIRS1",14,0)
 ;      ACRSTNO   =  STATE IEN
"RTN","ACRFIRS1",15,0)
 ;      ACRSTAN   =  STATE IEN THE REPORT IS FOR
"RTN","ACRFIRS1",16,0)
 ;      ACRSADR   =  VENDOR ADDRESS TYPE TO BE USED
"RTN","ACRFIRS1",17,0)
 ;      ACRZOUT   =  QUIT CONTROLLER VARIABLE
"RTN","ACRFIRS1",18,0)
 ;      ACRCNTA   =  COUNT OF A RECORDS
"RTN","ACRFIRS1",19,0)
 ;      ACRCNTB   =  COUNT OF B RECORDS
"RTN","ACRFIRS1",20,0)
 ;      ACRVEND0  =  LOOP COUNTER IN VENDOR FILE, VENDOR IEN
"RTN","ACRFIRS1",21,0)
 ;      ACRNAME   =  VENDOR NAME
"RTN","ACRFIRS1",22,0)
 ;      ACRAMT    =  VENDOR YTD PAID AMOUNT
"RTN","ACRFIRS1",23,0)
 ;      ACRTIN    =  VENDOR TIN#
"RTN","ACRFIRS1",24,0)
 ;      ACRADD    =  VENDOR ADDRESS
"RTN","ACRFIRS1",25,0)
 ;      ACRCITY   =  VENDOR CITY
"RTN","ACRFIRS1",26,0)
 ;      ACRSTAB   =  VENDOR STATE ABBREVIATION
"RTN","ACRFIRS1",27,0)
 ;      ACRZIP    =  VENDOR ZIP CODE
"RTN","ACRFIRS1",28,0)
 ;      ACRPMYR   =  PAYMENT YEAR
"RTN","ACRFIRS1",29,0)
 ;      ACRTOT(   =  ARRAY CONTAINING PAYMENT TOTALS
"RTN","ACRFIRS1",30,0)
 ;      ACRTOTAL  =  PAYMENT GRAND TOTAL
"RTN","ACRFIRS1",31,0)
 ;      ACRAMTCD  =  PAYMENT AMOUNT TYPE CODE
"RTN","ACRFIRS1",32,0)
 ;
"RTN","ACRFIRS1",33,0)
 ;
"RTN","ACRFIRS1",34,0)
EN ;EP -- MAIN ENTRY POINT
"RTN","ACRFIRS1",35,0)
 ;
"RTN","ACRFIRS1",36,0)
 N ACRAREA,ACRFSTN,ACRPMYR,ACRSADR,ACRSTA,ACRSTAN
"RTN","ACRFIRS1",37,0)
 ;
"RTN","ACRFIRS1",38,0)
 D ^XBKVAR
"RTN","ACRFIRS1",39,0)
 D HOME^%ZIS
"RTN","ACRFIRS1",40,0)
 ;
"RTN","ACRFIRS1",41,0)
 D AREA(.ACRAREA)
"RTN","ACRFIRS1",42,0)
 Q:'$G(ACRAREA)
"RTN","ACRFIRS1",43,0)
 ;
"RTN","ACRFIRS1",44,0)
 D STATE(.ACRSTA,.ACRFSTN,.ACRSTAN)
"RTN","ACRFIRS1",45,0)
 Q:$G(ACRSTA)']""
"RTN","ACRFIRS1",46,0)
 ;
"RTN","ACRFIRS1",47,0)
 D YEAR(.ACRPMYR)
"RTN","ACRFIRS1",48,0)
 Q:'$G(ACRPMYR)
"RTN","ACRFIRS1",49,0)
 ;
"RTN","ACRFIRS1",50,0)
 D ADDRESS(.ACRSADR)
"RTN","ACRFIRS1",51,0)
 Q:$G(ACRSADR)']""
"RTN","ACRFIRS1",52,0)
 ;
"RTN","ACRFIRS1",53,0)
 D GET(ACRAREA,ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN)
"RTN","ACRFIRS1",54,0)
 ;
"RTN","ACRFIRS1",55,0)
 D UNIX(ACRFSTN)
"RTN","ACRFIRS1",56,0)
 ;
"RTN","ACRFIRS1",57,0)
 D PRINT(ACRPMYR,ACRSTA)
"RTN","ACRFIRS1",58,0)
 ;
"RTN","ACRFIRS1",59,0)
 K ^TMP("ACRZ",$J,"RECORD")
"RTN","ACRFIRS1",60,0)
 D ^%ZISC
"RTN","ACRFIRS1",61,0)
 Q
"RTN","ACRFIRS1",62,0)
GET(ACRAREA,ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN)     ;
"RTN","ACRFIRS1",63,0)
 ;----- GATHER DATA AND PUT INTO ^TMP GLOBAL
"RTN","ACRFIRS1",64,0)
 ;
"RTN","ACRFIRS1",65,0)
 ;      INPUT:
"RTN","ACRFIRS1",66,0)
 ;      ACRAREA = FINANCE AREA
"RTN","ACRFIRS1",67,0)
 ;      ACRPMYR = PAYMENT YEAR
"RTN","ACRFIRS1",68,0)
 ;      ACRSADR = VENDOR ADDRESS TYPE
"RTN","ACRFIRS1",69,0)
 ;      ACRFSTN = STATE NAME
"RTN","ACRFIRS1",70,0)
 ;      ACRSTAN = STATE IEN
"RTN","ACRFIRS1",71,0)
 ;
"RTN","ACRFIRS1",72,0)
 ;      OTHER VARIABLES USED:
"RTN","ACRFIRS1",73,0)
 ;      ACRCNTA = COUNT OF A RECORDS
"RTN","ACRFIRS1",74,0)
 ;      ACRCNTB = COUNT OF B RECORDS
"RTN","ACRFIRS1",75,0)
 ;      ACRTOT( = ARRAY CONTAINING PAYMENT TOTALS
"RTN","ACRFIRS1",76,0)
 ;
"RTN","ACRFIRS1",77,0)
 N ACRCNTA,ACRCNTB,ACRTOT
"RTN","ACRFIRS1",78,0)
 ;
"RTN","ACRFIRS1",79,0)
 K ^TMP("ACRZ",$J)
"RTN","ACRFIRS1",80,0)
 ;
"RTN","ACRFIRS1",81,0)
 W !,"Working..."
"RTN","ACRFIRS1",82,0)
 ;
"RTN","ACRFIRS1",83,0)
 D RECORDA^ACRFIRS2(ACRAREA,ACRPMYR,.ACRCNTA)
"RTN","ACRFIRS1",84,0)
 ;
"RTN","ACRFIRS1",85,0)
 D LOOP(ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN,.ACRTOT,.ACRCNTB)
"RTN","ACRFIRS1",86,0)
 ;
"RTN","ACRFIRS1",87,0)
 D RECORDC^ACRFIRS2(ACRAREA,.ACRTOT,ACRCNTB)
"RTN","ACRFIRS1",88,0)
 ;
"RTN","ACRFIRS1",89,0)
 D RECORDF^ACRFIRS2(ACRCNTA)
"RTN","ACRFIRS1",90,0)
 ;
"RTN","ACRFIRS1",91,0)
 D RECORDT^ACRFIRS2(ACRAREA,ACRPMYR,ACRCNTB)
"RTN","ACRFIRS1",92,0)
 ;
"RTN","ACRFIRS1",93,0)
 Q
"RTN","ACRFIRS1",94,0)
LOOP(ACRPMYR,ACRSADR,ACRFSTN,ACRSTAN,ACRTOT,ACRCNTB)       ;
"RTN","ACRFIRS1",95,0)
 ;----- LOOP THROUGH VENDOR FILE AND GATHER RECORD B DATA
"RTN","ACRFIRS1",96,0)
 ;
"RTN","ACRFIRS1",97,0)
 ;      INPUT:
"RTN","ACRFIRS1",98,0)
 ;      ACRPMYR = PAYMENT YEAR
"RTN","ACRFIRS1",99,0)
 ;      ACRSADR = VENDOR ADDRESS TYPE
"RTN","ACRFIRS1",100,0)
 ;      ACRFSTN = STATE NAME
"RTN","ACRFIRS1",101,0)
 ;      ACRSTAN = STATE IEN
"RTN","ACRFIRS1",102,0)
 ;      ACRTOT( = ARRAY CONTAINING PAYMENT TOTALS
"RTN","ACRFIRS1",103,0)
 ;
"RTN","ACRFIRS1",104,0)
 ;      RETURNS:
"RTN","ACRFIRS1",105,0)
 ;      ACRCNTB = COUNT OF B RECORDS
"RTN","ACRFIRS1",106,0)
 ;
"RTN","ACRFIRS1",107,0)
 ;      OTHER VARIABLES USED:
"RTN","ACRFIRS1",108,0)
 ;      ACRADD   = VENDOR ADDRESS
"RTN","ACRFIRS1",109,0)
 ;      ACRAMT   = PAYMENT AMOUNT
"RTN","ACRFIRS1",110,0)
 ;      ACRAMTCD = PAYMENT AMOUNT CODE
"RTN","ACRFIRS1",111,0)
 ;      ACRCITY  = VENDOR CITY
"RTN","ACRFIRS1",112,0)
 ;      ACRNAME  = VENDOR NAME
"RTN","ACRFIRS1",113,0)
 ;      ACRSTAB  = VENDOR STATE ABBREVIATION
"RTN","ACRFIRS1",114,0)
 ;      ACRSTNO  = STATE IEN
"RTN","ACRFIRS1",115,0)
 ;      ACRTIN   = VENDOR TIN#
"RTN","ACRFIRS1",116,0)
 ;      ACRTOTAL = PAMENT GRAND TOTAL
"RTN","ACRFIRS1",117,0)
 ;      ACRVEND0 = LOOP COUNTER IN VENDOR FILE (VENDOR IEN)
"RTN","ACRFIRS1",118,0)
 ;      ACRZIP   = VENDOR ZIP CODE
"RTN","ACRFIRS1",119,0)
 ;   
"RTN","ACRFIRS1",120,0)
 ;
"RTN","ACRFIRS1",121,0)
 N ACRADD,ACRAMT,ACRAMTCD,ACRCITY,ACRNAME,ACRSTAB,ACRSTNO,ACRTIN,ACRTOTAL,ACRVEND0,ACRZIP,DATA,I
"RTN","ACRFIRS1",122,0)
 ;
"RTN","ACRFIRS1",123,0)
 K ACRTOT
"RTN","ACRFIRS1",124,0)
 ;
"RTN","ACRFIRS1",125,0)
 F I=1:1:9,"A","B","C" S ACRTOT(I)=0
"RTN","ACRFIRS1",126,0)
 ;
"RTN","ACRFIRS1",127,0)
 S (ACRVEND0,ACRCNTB,ACRTOTAL)=0
"RTN","ACRFIRS1",128,0)
 F  S ACRVEND0=$O(^ACR1099V("C",ACRPMYR,ACRVEND0)) Q:'ACRVEND0  D
"RTN","ACRFIRS1",129,0)
 . S ACRNAME=$P(^AUTTVNDR(ACRVEND0,0),U)
"RTN","ACRFIRS1",130,0)
 . Q:'$D(^AUTTVNDR(ACRVEND0,11))
"RTN","ACRFIRS1",131,0)
 . S ACRAMTCD=$P($G(^ACR1099V(ACRVEND0,0)),U,2)
"RTN","ACRFIRS1",132,0)
 . Q:ACRAMTCD=""
"RTN","ACRFIRS1",133,0)
 . S ACRAMT=+$P(^ACR1099V(ACRVEND0,1,ACRPMYR,0),U,2)
"RTN","ACRFIRS1",134,0)
 . Q:'ACRAMT
"RTN","ACRFIRS1",135,0)
 . S ACRAMT=ACRAMT*100
"RTN","ACRFIRS1",136,0)
 . Q:ACRAMT<60000
"RTN","ACRFIRS1",137,0)
 . S ACRTIN=$P($G(^AUTTVNDR(ACRVEND0,11)),U)
"RTN","ACRFIRS1",138,0)
 . Q:ACRTIN=""
"RTN","ACRFIRS1",139,0)
 . I ACRSADR="M" D
"RTN","ACRFIRS1",140,0)
 . . S DATA=$G(^AUTTVNDR(ACRVEND0,13))
"RTN","ACRFIRS1",141,0)
 . . S ACRADD=$P(DATA,U)
"RTN","ACRFIRS1",142,0)
 . . S ACRCITY=$P(DATA,U,2)
"RTN","ACRFIRS1",143,0)
 . . S ACRSTNO=$P(DATA,U,3)
"RTN","ACRFIRS1",144,0)
 . . S ACRSTAB=$P($G(^DIC(5,ACRSTNO,0)),U,2)
"RTN","ACRFIRS1",145,0)
 . . S ACRZIP=$P(DATA,U,4)
"RTN","ACRFIRS1",146,0)
 . I ACRSADR="B" D
"RTN","ACRFIRS1",147,0)
 . . S DATA=$G(^AUTTVNDR(ACRVEND0,13))
"RTN","ACRFIRS1",148,0)
 . . S ACRADD=$P(DATA,U,6)
"RTN","ACRFIRS1",149,0)
 . . S ACRCITY=$P(DATA,U,7)
"RTN","ACRFIRS1",150,0)
 . . S ACRSTNO=$P(DATA,U,8)
"RTN","ACRFIRS1",151,0)
 . . S ACRSTAB=$P($G(^DIC(5,ACRSTNO,0)),U,2)
"RTN","ACRFIRS1",152,0)
 . . S ACRZIP=$P(DATA,U,9)
"RTN","ACRFIRS1",153,0)
 . I ACRSADR="R" D
"RTN","ACRFIRS1",154,0)
 . . S DATA=$G(^AUTTVNDR(ACRVEND0,14))
"RTN","ACRFIRS1",155,0)
 . . S ACRADD=$P(DATA,U)
"RTN","ACRFIRS1",156,0)
 . . S ACRCITY=$P(DATA,U,3)
"RTN","ACRFIRS1",157,0)
 . . S ACRSTNO=$P(DATA,U,4)
"RTN","ACRFIRS1",158,0)
 . . S ACRSTAB=$P($G(^DIC(5,ACRSTNO,0)),U,2)
"RTN","ACRFIRS1",159,0)
 . . S ACRZIP=$P(DATA,U,5)
"RTN","ACRFIRS1",160,0)
 . Q:ACRADD=""
"RTN","ACRFIRS1",161,0)
 . Q:ACRCITY=""
"RTN","ACRFIRS1",162,0)
 . Q:ACRSTAB=""
"RTN","ACRFIRS1",163,0)
 . Q:ACRZIP=""
"RTN","ACRFIRS1",164,0)
 . I ACRFSTN'="US" Q:ACRSTNO'=ACRSTAN
"RTN","ACRFIRS1",165,0)
 . S ACRTOTAL=$G(ACRTOTAL)+ACRAMT
"RTN","ACRFIRS1",166,0)
 . D RECORDB^ACRFIRS2(ACRPMYR,ACRNAME,ACRTIN,ACRVEND0,ACRAMT,ACRAMTCD,ACRADD,ACRCITY,ACRSTAB,ACRZIP,.ACRCNTB,.ACRTOT)
"RTN","ACRFIRS1",167,0)
 . S ^TMP("ACRZ",$J,"REPORT",ACRVEND0,0)=ACRNAME_U_$E(ACRTIN,2,10)_U_ACRAMT
"RTN","ACRFIRS1",168,0)
 S ^TMP("ACRZ",$J,"REPORT TOTAL",0)=ACRTOTAL
"RTN","ACRFIRS1",169,0)
 Q
"RTN","ACRFIRS1",170,0)
PRINT(ACRPMYR,ACRSTA)        ;
"RTN","ACRFIRS1",171,0)
 ;----- PROMPT FOR DEVICE TO PRINT REPORT TO
"RTN","ACRFIRS1",172,0)
 ;
"RTN","ACRFIRS1",173,0)
 N ACRJ,ZTSAVE
"RTN","ACRFIRS1",174,0)
 D HOME^%ZIS
"RTN","ACRFIRS1",175,0)
 S ACRJ=$J
"RTN","ACRFIRS1",176,0)
 S ZTSAVE("ACRJ")=""
"RTN","ACRFIRS1",177,0)
 S ZTSAVE("ACRPMYR")=""
"RTN","ACRFIRS1",178,0)
 S ZTSAVE("ACRSTA")=""
"RTN","ACRFIRS1",179,0)
 D QUE^ACRFUTL("DQ^ACRFIRS3",.ZTSAVE,"1099 VENDOR REPORT")
"RTN","ACRFIRS1",180,0)
 Q
"RTN","ACRFIRS1",181,0)
 ;
"RTN","ACRFIRS1",182,0)
AREA(ACRAREA)      ;
"RTN","ACRFIRS1",183,0)
 ;----- PROMPT FOR AREA
"RTN","ACRFIRS1",184,0)
 ;
"RTN","ACRFIRS1",185,0)
 ;      RETURNS:
"RTN","ACRFIRS1",186,0)
 ;      ACRAREA = FINANCE AREA
"RTN","ACRFIRS1",187,0)
 ;
"RTN","ACRFIRS1",188,0)
 N DIC,X,Y
"RTN","ACRFIRS1",189,0)
 S ACRAREA=""
"RTN","ACRFIRS1",190,0)
 S DIC="^ACR1099P("
"RTN","ACRFIRS1",191,0)
 S DIC(0)="AQZEM"
"RTN","ACRFIRS1",192,0)
 D ^DIC
"RTN","ACRFIRS1",193,0)
 K DIC
"RTN","ACRFIRS1",194,0)
 Q:+Y'>0!($D(DTOUT))!($D(DUOUT))
"RTN","ACRFIRS1",195,0)
 S ACRAREA=+Y
"RTN","ACRFIRS1",196,0)
 Q
"RTN","ACRFIRS1",197,0)
 ;
"RTN","ACRFIRS1",198,0)
STATE(ACRSTA,ACRFSTN,ACRSTAN)          ;
"RTN","ACRFIRS1",199,0)
 ;----- PROMPT FOR STATE OR IRS
"RTN","ACRFIRS1",200,0)
 ;
"RTN","ACRFIRS1",201,0)
 ;      RETURNS:
"RTN","ACRFIRS1",202,0)
 ;      ACRSTA  = ANSWER IRS OR STATE
"RTN","ACRFIRS1",203,0)
 ;      ACRFSTN = STATE NAME
"RTN","ACRFIRS1",204,0)
 ;      ACRSTAN = STATE IEN
"RTN","ACRFIRS1",205,0)
 ;
"RTN","ACRFIRS1",206,0)
STA ;----- PROMPT LOOP
"RTN","ACRFIRS1",207,0)
 ;
"RTN","ACRFIRS1",208,0)
 N DIR,X,Y
"RTN","ACRFIRS1",209,0)
 S (ACRSTA,ACRFSTN,ACRSTAN)=""
"RTN","ACRFIRS1",210,0)
 S DIR(0)="F^2:3^K:X'?.U X"
"RTN","ACRFIRS1",211,0)
 S DIR("A")="Enter 2 character State Abbreviation or 'IRS'"
"RTN","ACRFIRS1",212,0)
 S DIR("A",1)=""
"RTN","ACRFIRS1",213,0)
 S DIR("A",2)="This generates files containing 1099 records.  You must select a STATE or IRS"
"RTN","ACRFIRS1",214,0)
 S DIR("A",3)="and a file will be generated for that selection.  You may run this program"
"RTN","ACRFIRS1",215,0)
 S DIR("A",4)="as many times as necessary until all STATE files needed are created."
"RTN","ACRFIRS1",216,0)
 S DIR("A",5)=""
"RTN","ACRFIRS1",217,0)
 D ^DIR
"RTN","ACRFIRS1",218,0)
 Q:Y']""!($D(DTOUT))!($D(DUOUT))!($D(DIRUT))
"RTN","ACRFIRS1",219,0)
 S (ACRSTA,ACRFSTN)=Y
"RTN","ACRFIRS1",220,0)
 I ACRFSTN="IRS" S ACRFSTN="US" Q
"RTN","ACRFIRS1",221,0)
 S ACRSTAN=$O(^DIC(5,"C",ACRSTA,0))
"RTN","ACRFIRS1",222,0)
 I 'ACRSTAN W *7,"   NO SUCH STATE",! K ACRSTA,ACRSTAN,ACRFSTN G STA
"RTN","ACRFIRS1",223,0)
 Q
"RTN","ACRFIRS1",224,0)
 ;
"RTN","ACRFIRS1",225,0)
YEAR(ACRPMYR)      ;
"RTN","ACRFIRS1",226,0)
 ;----- PROMPT FOR YEAR
"RTN","ACRFIRS1",227,0)
 ;
"RTN","ACRFIRS1",228,0)
 ;      RETURNS:
"RTN","ACRFIRS1",229,0)
 ;      ACRPMYR = PAYMENT YEAR
"RTN","ACRFIRS1",230,0)
 ;
"RTN","ACRFIRS1",231,0)
 N DIR,X,Y
"RTN","ACRFIRS1",232,0)
 S ACRPMYR=""
"RTN","ACRFIRS1",233,0)
 S DIR(0)="N^0000:9999"
"RTN","ACRFIRS1",234,0)
 S DIR("A")="Enter Calendar Year (eg 1998)"
"RTN","ACRFIRS1",235,0)
 S DIR("B")=($E(DT,1,3)+1700)-1
"RTN","ACRFIRS1",236,0)
 D ^DIR
"RTN","ACRFIRS1",237,0)
 Q:+Y'>0!($D(DTOUT))!($D(DUOUT))!($D(DIRUT))
"RTN","ACRFIRS1",238,0)
 S ACRPMYR=Y
"RTN","ACRFIRS1",239,0)
 Q
"RTN","ACRFIRS1",240,0)
 ;
"RTN","ACRFIRS1",241,0)
ADDRESS(ACRSADR)   ;
"RTN","ACRFIRS1",242,0)
 ;----- PROMPT FOR ADDRESS TO USE
"RTN","ACRFIRS1",243,0)
 ;
"RTN","ACRFIRS1",244,0)
 ;      RETURNS:
"RTN","ACRFIRS1",245,0)
 ;      ACRSADR = VENDOR ADDRESS TYPE
"RTN","ACRFIRS1",246,0)
 ;
"RTN","ACRFIRS1",247,0)
 N DIR,X,Y
"RTN","ACRFIRS1",248,0)
 S ACRSADR=""
"RTN","ACRFIRS1",249,0)
 S DIR(0)="S^M:Mailing Address;B:Billing Address;R:Remit To Address"
"RTN","ACRFIRS1",250,0)
 S DIR("A")="Which VENDOR File Address is to be used?"
"RTN","ACRFIRS1",251,0)
 S DIR("B")="M"
"RTN","ACRFIRS1",252,0)
 D ^DIR
"RTN","ACRFIRS1",253,0)
 Q:Y']""!($D(DTOUT))!($D(DIROUT))!($D(DUOUT))
"RTN","ACRFIRS1",254,0)
 S ACRSADR=Y
"RTN","ACRFIRS1",255,0)
 Q
"RTN","ACRFIRS1",256,0)
 ;
"RTN","ACRFIRS1",257,0)
 ;
"RTN","ACRFIRS1",258,0)
UNIX(ACRSTN)       ;
"RTN","ACRFIRS1",259,0)
 ;----- WRITE ^TMP GLOBAL TO UNIX FILE
"RTN","ACRFIRS1",260,0)
 ;
"RTN","ACRFIRS1",261,0)
 N %DEV,ACRAREA,ACRDIR,ACRFILE,ACRVEND0,ACRZOUT,I,J
"RTN","ACRFIRS1",262,0)
 Q:'$D(^TMP("ACRZ",$J))
"RTN","ACRFIRS1",263,0)
 S ACRDIR=$P($G(^ACRSYS(1,402)),U,3) ;CHANGE TO ARMS DEFAULT DIRECTORY IN V2.2
"RTN","ACRFIRS1",264,0)
 D HFS(ACRDIR,ACRSTN,.ACRZOUT,.ACRFILE,.%DEV)
"RTN","ACRFIRS1",265,0)
 Q:$G(ACRZOUT)
"RTN","ACRFIRS1",266,0)
 U %DEV
"RTN","ACRFIRS1",267,0)
 F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","T",I))
"RTN","ACRFIRS1",268,0)
 S ACRAREA=0
"RTN","ACRFIRS1",269,0)
 F  S ACRAREA=$O(^TMP("ACRZ",$J,"RECORD","A",ACRAREA)) Q:'ACRAREA  D
"RTN","ACRFIRS1",270,0)
 . F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","A",ACRAREA,I))
"RTN","ACRFIRS1",271,0)
 . S ACRVEND0=0
"RTN","ACRFIRS1",272,0)
 . F  S ACRVEND0=$O(^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0)) Q:'ACRVEND0  D
"RTN","ACRFIRS1",273,0)
 . . F J=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0,J))
"RTN","ACRFIRS1",274,0)
 . F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","C",ACRAREA,I))
"RTN","ACRFIRS1",275,0)
 F I=1:1:4 W $G(^TMP("ACRZ",$J,"RECORD","F",I))
"RTN","ACRFIRS1",276,0)
 U 0 W !!,"Records have been put into file "_ACRDIR_ACRFILE
"RTN","ACRFIRS1",277,0)
 D CLOSE^%ZISH("FILE")
"RTN","ACRFIRS1",278,0)
 K %DEV
"RTN","ACRFIRS1",279,0)
 Q
"RTN","ACRFIRS1",280,0)
HFS(ACRDIR,ACRSTN,ACRZOUT,ACRFILE,%DEV)          ;
"RTN","ACRFIRS1",281,0)
 ;----- CREATE AND OPEN UNIX FILE
"RTN","ACRFIRS1",282,0)
 ;
"RTN","ACRFIRS1",283,0)
 N POP,X,Y
"RTN","ACRFIRS1",284,0)
 S ACRFILE="acrirs"_ACRFSTN_"."_$E(DT,1,3)_$$JDATE^ACRFUTL
"RTN","ACRFIRS1",285,0)
 D OPEN^%ZISH("FILE",ACRDIR,ACRFILE,"W")
"RTN","ACRFIRS1",286,0)
 I POP D  Q
"RTN","ACRFIRS1",287,0)
 . S ACRZOUT=1
"RTN","ACRFIRS1",288,0)
 . W !,"UNABLE TO OPEN FILE "_ACRFILE
"RTN","ACRFIRS1",289,0)
 S %DEV=IO
"RTN","ACRFIRS1",290,0)
 Q
"RTN","ACRFIRS1",291,0)
 ;
"RTN","ACRFIRS1",292,0)
NCTL(X) ;EP -- NAME CONTROL - RETURNS FIRST 4 SIGNIFICANT CHARACTERS
"RTN","ACRFIRS1",293,0)
 ;
"RTN","ACRFIRS1",294,0)
 ;      X  =  VENDOR NAME
"RTN","ACRFIRS1",295,0)
 ;
"RTN","ACRFIRS1",296,0)
 S X=$TR(X," ~!@#$%^*()_+`-={}|[]\:"""";'<>?,./","")
"RTN","ACRFIRS1",297,0)
 S X=$E(X,1,4)
"RTN","ACRFIRS1",298,0)
 Q X
"RTN","ACRFIRS2")
0^2^B84358542
"RTN","ACRFIRS2",1,0)
ACRFIRS2 ;IHS/OIRM/DSD/AEF - 1099 RECORD A,B,C,F,T LAYOUTS; [ 01/08/2002  9:04 AM ]
"RTN","ACRFIRS2",2,0)
 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**1**;NOV 05, 2001
"RTN","ACRFIRS2",3,0)
 ;
"RTN","ACRFIRS2",4,0)
 ;
"RTN","ACRFIRS2",5,0)
 ;      This routine is called by ACRFIRS1 to format 1099 record data
"RTN","ACRFIRS2",6,0)
 ;      into a ^TMP global using the record layouts specified in
"RTN","ACRFIRS2",7,0)
 ;      Department of the Treasury Internal Revenue Service
"RTN","ACRFIRS2",8,0)
 ;      Publication 1220 Catalog Number 61275P.
"RTN","ACRFIRS2",9,0)
 ;      Variables are set by ACRFIRS1.
"RTN","ACRFIRS2",10,0)
 Q
"RTN","ACRFIRS2",11,0)
RECORDA(ACRAREA,ACRPMYR,ACRCNTA)       ;EP
"RTN","ACRFIRS2",12,0)
 ;----- CREATE RECORD TYPE A (PAYER)
"RTN","ACRFIRS2",13,0)
 ;
"RTN","ACRFIRS2",14,0)
 ;LAYOUT
"RTN","ACRFIRS2",15,0)
 ;1  -  1 "A"                    51 - 51 BLANK
"RTN","ACRFIRS2",16,0)
 ;2  -  5 YEAR                   52 - 52 FOREIGN ENTITY INDICATOR
"RTN","ACRFIRS2",17,0)
 ;6  - 11 BLANK                  53 - 92 FIRST PAYER NAME LINE
"RTN","ACRFIRS2",18,0)
 ;12 - 20 PAYER'S TIN#           93 -132 SECOND PAYER NAME LINE
"RTN","ACRFIRS2",19,0)
 ;21 - 24 PAYER NAME CONTROL     133-133 TRANSFER AGENT INDICATOR
"RTN","ACRFIRS2",20,0)
 ;25 - 25 LAST FILING INDICATOR  134-173 PAYER SHIPPING ADDRESS
"RTN","ACRFIRS2",21,0)
 ;26 - 26 COMB FED/STTE FILER    174-213 PAYER CITY
"RTN","ACRFIRS2",22,0)
 ;27 - 27 TYPE OF RETURN         214-215 PAYER STATE
"RTN","ACRFIRS2",23,0)
 ;28 - 39 AMOUNT CODES           216-224 PAYER ZIP CODE
"RTN","ACRFIRS2",24,0)
 ;40 - 47 BLANK                  225-239 PAYER'S PHONE & EXT
"RTN","ACRFIRS2",25,0)
 ;48 - 48 ORIGINAL FILE IND      240-748 BLANK
"RTN","ACRFIRS2",26,0)
 ;49 - 49 REPLACEMENT FILE IND   749-750 BLANK OR CR/LF
"RTN","ACRFIRS2",27,0)
 ;50 - 50 CORRECTION FILE IND
"RTN","ACRFIRS2",28,0)
 ;
"RTN","ACRFIRS2",29,0)
 ;      INPUT:
"RTN","ACRFIRS2",30,0)
 ;      ACRAREA = PAYER NAME
"RTN","ACRFIRS2",31,0)
 ;      ACRPMYR = PAYMENT CALENDAR YEAR
"RTN","ACRFIRS2",32,0)
 ;
"RTN","ACRFIRS2",33,0)
 ;      RETURNS:
"RTN","ACRFIRS2",34,0)
 ;      ACRCNTA = RECORD A COUNT
"RTN","ACRFIRS2",35,0)
 ;
"RTN","ACRFIRS2",36,0)
 N DATA,I,X,Z
"RTN","ACRFIRS2",37,0)
 S DATA=^ACR1099P(ACRAREA,0)
"RTN","ACRFIRS2",38,0)
 S $E(Z)="A"
"RTN","ACRFIRS2",39,0)
 S $E(Z,2,5)=ACRPMYR
"RTN","ACRFIRS2",40,0)
 S $E(Z,6,11)=$$PAD^ACRFUTL("","R",6,"")
"RTN","ACRFIRS2",41,0)
 S $E(Z,12,20)=$P(DATA,U,8)
"RTN","ACRFIRS2",42,0)
 S $E(Z,21,24)=$$PAD^ACRFUTL($P(DATA,U,9),"R",4,"")
"RTN","ACRFIRS2",43,0)
 S $E(Z,25)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",44,0)
 S $E(Z,26)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",45,0)
 S $E(Z,27)="A"
"RTN","ACRFIRS2",46,0)
 S $E(Z,28,39)=$$PAD^ACRFUTL($P(DATA,U,11),"R",12,"")
"RTN","ACRFIRS2",47,0)
 S $E(Z,40,47)=$$PAD^ACRFUTL("","R",8,"")
"RTN","ACRFIRS2",48,0)
 S $E(Z,48)=1
"RTN","ACRFIRS2",49,0)
 S $E(Z,49)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",50,0)
 S $E(Z,50)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",51,0)
 S $E(Z,51)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",52,0)
 S $E(Z,52)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",53,0)
 S $E(Z,53,92)=$$PAD^ACRFUTL($P(DATA,U,2),"R",40,"")
"RTN","ACRFIRS2",54,0)
 S $E(Z,93,132)=$$PAD^ACRFUTL($P(DATA,U,3),"R",40,"")
"RTN","ACRFIRS2",55,0)
 S $E(Z,133)=0
"RTN","ACRFIRS2",56,0)
 S $E(Z,134,173)=$$PAD^ACRFUTL($P(DATA,U,4),"R",40,"")
"RTN","ACRFIRS2",57,0)
 S $E(Z,174,213)=$$PAD^ACRFUTL($P(DATA,U,5),"R",40,"")
"RTN","ACRFIRS2",58,0)
 S $E(Z,214,215)=$P($G(^DIC(5,$P(DATA,U,6),0)),U,2)
"RTN","ACRFIRS2",59,0)
 S $E(Z,216,224)=$$PAD^ACRFUTL($TR($P(DATA,U,7),"-",""),"R",9,"")
"RTN","ACRFIRS2",60,0)
 S $E(Z,225,239)=$$PAD^ACRFUTL($P(DATA,U,12),"R",15,"")
"RTN","ACRFIRS2",61,0)
 S $E(Z,240,748)=$$PAD^ACRFUTL("","R",509,"")
"RTN","ACRFIRS2",62,0)
 S $E(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
"RTN","ACRFIRS2",63,0)
 S ACRCNTA=$G(ACRCNTA)+1
"RTN","ACRFIRS2",64,0)
 ;
"RTN","ACRFIRS2",65,0)
 S ^TMP("ACRZ",$J,"RECORD","A",ACRAREA,1)=$E(Z,1,240)
"RTN","ACRFIRS2",66,0)
 S ^TMP("ACRZ",$J,"RECORD","A",ACRAREA,2)=$E(Z,241,480)
"RTN","ACRFIRS2",67,0)
 S ^TMP("ACRZ",$J,"RECORD","A",ACRAREA,3)=$E(Z,481,720)
"RTN","ACRFIRS2",68,0)
 S ^TMP("ACRZ",$J,"RECORD","A",ACRAREA,4)=$E(Z,721,750)
"RTN","ACRFIRS2",69,0)
 Q
"RTN","ACRFIRS2",70,0)
RECORDB(ACRPMYR,ACRNAME,ACRTIN,ACRVEND0,ACRAMT,ACRAMTCD,ACRADD,ACRCITY,ACRSTAB,ACRZIP,ACRCNTB,ACRTOT)        ;EP
"RTN","ACRFIRS2",71,0)
 ;----- CREATE RECORD TYPE B (PAYEE)
"RTN","ACRFIRS2",72,0)
 ;      FOR 1099-MISC
"RTN","ACRFIRS2",73,0)
 ;
"RTN","ACRFIRS2",74,0)
 ;LAYOUT:
"RTN","ACRFIRS2",75,0)
 ;1  -  1 "B"                  247-247 FOREIGN COUNTRY INDICATOR
"RTN","ACRFIRS2",76,0)
 ;2  -  5 PAYMENT YEAR         248-287 FIRST PAYEE NAME LINE    
"RTN","ACRFIRS2",77,0)
 ;6  -  6 CORRECTED RETURN IND 288-327 SECOND PAYEE NAME LINE
"RTN","ACRFIRS2",78,0)
 ;7  - 10 NAME CONTROL         328-367 BLANK
"RTN","ACRFIRS2",79,0)
 ;11 - 11 TYPE OF TIN          368-407 PAYEE MAILING ADDRESS
"RTN","ACRFIRS2",80,0)
 ;12 - 20 PAYEE'S TIN          408-447 BLANK
"RTN","ACRFIRS2",81,0)
 ;21 - 40 PAYER'S ACCOUNT NO   448-487 PAYEE CITY 
"RTN","ACRFIRS2",82,0)
 ;41 - 44 PAYER'S OFFICE CODE  488-489 PAYEE STATE
"RTN","ACRFIRS2",83,0)
 ;45 - 54 BLANK                490-498 PAYEE ZIP CODE
"RTN","ACRFIRS2",84,0)
 ;55 - 66 PAYMENT AMOUNT 1     499-543 BLANK
"RTN","ACRFIRS2",85,0)
 ;67 - 78 PAYMENT AMOUNT 2     544-544 SECOND TIN NOTICE (OPTIONAL)
"RTN","ACRFIRS2",86,0)
 ;79 - 90 PAYMENT AMOUNT 3     545-546 BLANKS
"RTN","ACRFIRS2",87,0)
 ;91 -102 PAYMENT AMOUNT 4     547-547 DIRECT SALES INDICATOR
"RTN","ACRFIRS2",88,0)
 ;103-114 PAYMENT AMOUNT 5     548-662 BLANK
"RTN","ACRFIRS2",89,0)
 ;115-126 PAYMENT AMOUNT 6     663-722 SPECIAL DATA ENTRIES
"RTN","ACRFIRS2",90,0)
 ;127-138 PAYMENT AMOUNT 7     723-734 STATE INCOME TAX WITHHELD
"RTN","ACRFIRS2",91,0)
 ;139-150 PAYMENT AMOUNT 8     735-746 LOCAL INCOME TAX WITHHELD
"RTN","ACRFIRS2",92,0)
 ;151-162 PAYMENT AMOUNT 9     747-748 COMBINED FEDERAL/STATE CODE
"RTN","ACRFIRS2",93,0)
 ;163-174 PAYMENT AMOUNT A     749-750 BLANK
"RTN","ACRFIRS2",94,0)
 ;175-186 PAYMENT AMOUNT B
"RTN","ACRFIRS2",95,0)
 ;187-198 PAYMENT AMOUNT C
"RTN","ACRFIRS2",96,0)
 ;199-246 RESERVED (BLANK)
"RTN","ACRFIRS2",97,0)
 ;
"RTN","ACRFIRS2",98,0)
 ;      INPUT:
"RTN","ACRFIRS2",99,0)
 ;      ACRPMYR  = PAYMENT CALENDAR YEAR
"RTN","ACRFIRS2",100,0)
 ;      ACRNAME  = PAYEE NAME
"RTN","ACRFIRS2",101,0)
 ;      ACRTIN   = PAYEE TAX ID NUMBER
"RTN","ACRFIRS2",102,0)
 ;      ACRVEND0 = VENDOR IEN
"RTN","ACRFIRS2",103,0)
 ;      ACRAMT   = PAYMENT AMOUNT
"RTN","ACRFIRS2",104,0)
 ;      ACRAMTCD = PAYMENT AMOUNT CODE
"RTN","ACRFIRS2",105,0)
 ;      ACRADD   = PAYEE ADDRESS
"RTN","ACRFIRS2",106,0)
 ;      ACRCITY  = PAYEE CITY
"RTN","ACRFIRS2",107,0)
 ;      ACRSTAB  = PAYEE STATE
"RTN","ACRFIRS2",108,0)
 ;      ACRZIP   = PAYEE ZIP
"RTN","ACRFIRS2",109,0)
 ;
"RTN","ACRFIRS2",110,0)
 ;      RETURNS:
"RTN","ACRFIRS2",111,0)
 ;      ACRCNTB  = RECORD B COUNT
"RTN","ACRFIRS2",112,0)
 ;      ACRTOT(  = ARRAY CONTAINING PAYMENT AMOUNT CODE TOTALS
"RTN","ACRFIRS2",113,0)
 ;
"RTN","ACRFIRS2",114,0)
 N I,X,Z
"RTN","ACRFIRS2",115,0)
 S $E(Z)="B"
"RTN","ACRFIRS2",116,0)
 S $E(Z,2,5)=ACRPMYR
"RTN","ACRFIRS2",117,0)
 S $E(Z,6)=$$PAD^ACRFUTL("","R",1,"") ;corrected return indicator
"RTN","ACRFIRS2",118,0)
 S $E(Z,7,10)=$$PAD^ACRFUTL($$NCTL^ACRFIRS1(ACRNAME),"R",4,"")
"RTN","ACRFIRS2",119,0)
 S $E(Z,11)=$E(ACRTIN)
"RTN","ACRFIRS2",120,0)
 S $E(Z,12,20)=$E(ACRTIN,2,10)
"RTN","ACRFIRS2",121,0)
 S $E(Z,21,40)=$$PAD^ACRFUTL($P($G(^AUTTVNDR(ACRVEND0,19)),U,3),"R",20,"")
"RTN","ACRFIRS2",122,0)
 S $E(Z,41,44)=$$PAD^ACRFUTL("","R",4,"")
"RTN","ACRFIRS2",123,0)
 S $E(Z,45,54)=$$PAD^ACRFUTL("","R",10,"")
"RTN","ACRFIRS2",124,0)
 S $E(Z,55,198)=$$PAD^ACRFUTL(0,"L",144,0)
"RTN","ACRFIRS2",125,0)
 S ACRAMT=$$PAD^ACRFUTL(+ACRAMT,"L",12,0)
"RTN","ACRFIRS2",126,0)
 I ACRAMTCD[1 D
"RTN","ACRFIRS2",127,0)
 . S ACRTOT(1)=$G(ACRTOT(1))+ACRAMT
"RTN","ACRFIRS2",128,0)
 . S $E(Z,55,66)=ACRAMT
"RTN","ACRFIRS2",129,0)
 I ACRAMTCD[2 D
"RTN","ACRFIRS2",130,0)
 . S ACRTOT(2)=$G(ACRTOT(2))+ACRAMT
"RTN","ACRFIRS2",131,0)
 . S $E(Z,67,78)=ACRAMT
"RTN","ACRFIRS2",132,0)
 I ACRAMTCD[3 D
"RTN","ACRFIRS2",133,0)
 . S ACRTOT(3)=$G(ACRTOT(3))+ACRAMT
"RTN","ACRFIRS2",134,0)
 . S $E(Z,79,90)=ACRAMT
"RTN","ACRFIRS2",135,0)
 I ACRAMTCD[4 D
"RTN","ACRFIRS2",136,0)
 . S ACRTOT(4)=$G(ACRTOT(4))+ACRAMT
"RTN","ACRFIRS2",137,0)
 . S $E(Z,91,102)=ACRAMT
"RTN","ACRFIRS2",138,0)
 I ACRAMTCD[5 D
"RTN","ACRFIRS2",139,0)
 . S ACRTOT(5)=$G(ACRTOT(5))+ACRAMT
"RTN","ACRFIRS2",140,0)
 . S $E(Z,103,114)=ACRAMT
"RTN","ACRFIRS2",141,0)
 I ACRAMTCD[6 D
"RTN","ACRFIRS2",142,0)
 . S ACRTOT(6)=$G(ACRTOT(6))+ACRAMT
"RTN","ACRFIRS2",143,0)
 . S $E(Z,115,126)=ACRAMT
"RTN","ACRFIRS2",144,0)
 I ACRAMTCD[7 D
"RTN","ACRFIRS2",145,0)
 . S ACRTOT(7)=$G(ACRTOT(7))+ACRAMT
"RTN","ACRFIRS2",146,0)
 . S $E(Z,127,138)=ACRAMT
"RTN","ACRFIRS2",147,0)
 I ACRAMTCD[8 D
"RTN","ACRFIRS2",148,0)
 . S ACRTOT(8)=$G(ACRTOT(8))+ACRAMT
"RTN","ACRFIRS2",149,0)
 . S $E(Z,139,150)=ACRAMT
"RTN","ACRFIRS2",150,0)
 I ACRAMTCD[9 D
"RTN","ACRFIRS2",151,0)
 . S ACRTOT(9)=$G(ACRTOT(9))+ACRAMT
"RTN","ACRFIRS2",152,0)
 . S $E(Z,151,162)=ACRAMT
"RTN","ACRFIRS2",153,0)
 I ACRAMTCD["A" D
"RTN","ACRFIRS2",154,0)
 . S ACRTOT("A")=$G(ACRTOT("A"))+ACRAMT
"RTN","ACRFIRS2",155,0)
 . S $E(Z,163,174)=ACRAMT
"RTN","ACRFIRS2",156,0)
 I ACRAMTCD["B" D
"RTN","ACRFIRS2",157,0)
 . S ACRTOT("B")=$G(ACRTOT("B"))+ACRAMT
"RTN","ACRFIRS2",158,0)
 . S $E(Z,175,186)=ACRAMT
"RTN","ACRFIRS2",159,0)
 I ACRAMTCD["C" D
"RTN","ACRFIRS2",160,0)
 . S ACRTOT("C")=$G(ACRTOT("C"))+ACRAMT
"RTN","ACRFIRS2",161,0)
 . S $E(Z,187,198)=ACRAMT
"RTN","ACRFIRS2",162,0)
 S $E(Z,199,246)=$$PAD^ACRFUTL("","R",48,"")
"RTN","ACRFIRS2",163,0)
 S $E(Z,247)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",164,0)
 S $E(Z,248,287)=$$PAD^ACRFUTL(ACRNAME,"R",40,"")
"RTN","ACRFIRS2",165,0)
 S $E(Z,288,327)=$$PAD^ACRFUTL("","R",40,"")
"RTN","ACRFIRS2",166,0)
 S $E(Z,328,367)=$$PAD^ACRFUTL("","R",40,"")
"RTN","ACRFIRS2",167,0)
 S $E(Z,368,407)=$$PAD^ACRFUTL(ACRADD,"R",40,"")
"RTN","ACRFIRS2",168,0)
 S $E(Z,408,477)=$$PAD^ACRFUTL("","R",40,"")
"RTN","ACRFIRS2",169,0)
 S $E(Z,448,487)=$$PAD^ACRFUTL(ACRCITY,"R",40,"")
"RTN","ACRFIRS2",170,0)
 S $E(Z,488,489)=ACRSTAB
"RTN","ACRFIRS2",171,0)
 S $E(Z,490,498)=$$PAD^ACRFUTL($TR(ACRZIP,"-",""),"R",9,"")
"RTN","ACRFIRS2",172,0)
 S $E(Z,499,543)=$$PAD^ACRFUTL("","R",45,"")
"RTN","ACRFIRS2",173,0)
 S $E(Z,544)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",174,0)
 S $E(Z,545,546)=$$PAD^ACRFUTL("","R",2,"")
"RTN","ACRFIRS2",175,0)
 S $E(Z,547)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",176,0)
 S $E(Z,548,662)=$$PAD^ACRFUTL("","R",115,"")
"RTN","ACRFIRS2",177,0)
 S $E(Z,663,722)=$$PAD^ACRFUTL("","R",60,"")
"RTN","ACRFIRS2",178,0)
 S $E(Z,723,734)=$$PAD^ACRFUTL(0,"L",12,0)
"RTN","ACRFIRS2",179,0)
 S $E(Z,735,746)=$$PAD^ACRFUTL(0,"L",12,0)
"RTN","ACRFIRS2",180,0)
 S $E(Z,747,748)=$$PAD^ACRFUTL("","R",2,"")
"RTN","ACRFIRS2",181,0)
 S $E(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
"RTN","ACRFIRS2",182,0)
 S ACRCNTB=$G(ACRCNTB)+1
"RTN","ACRFIRS2",183,0)
 ;
"RTN","ACRFIRS2",184,0)
 S ^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0,1)=$E(Z,1,240)
"RTN","ACRFIRS2",185,0)
 S ^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0,2)=$E(Z,241,480)
"RTN","ACRFIRS2",186,0)
 S ^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0,3)=$E(Z,481,720)
"RTN","ACRFIRS2",187,0)
 S ^TMP("ACRZ",$J,"RECORD","B",ACRAREA,ACRVEND0,4)=$E(Z,721,750)
"RTN","ACRFIRS2",188,0)
 Q
"RTN","ACRFIRS2",189,0)
 ;
"RTN","ACRFIRS2",190,0)
RECORDC(ACRAREA,ACRTOT,ACRCNTB)        ;EP
"RTN","ACRFIRS2",191,0)
 ;----- CREATE RECORD TYPE C (END OF PAYER)
"RTN","ACRFIRS2",192,0)
 ;
"RTN","ACRFIRS2",193,0)
 ;LAYOUT
"RTN","ACRFIRS2",194,0)
 ;1  -  1 "C"                     124-141 CONTROL TOTAL 7
"RTN","ACRFIRS2",195,0)
 ;2  -  9 NUMBER OF PAYEES        142-159 CONTROL TOTAL 8
"RTN","ACRFIRS2",196,0)
 ;10 - 15 BLANK                   160-177 CONTROL TOTAL 9
"RTN","ACRFIRS2",197,0)
 ;16 - 33 CONTROL TOTAL 1         178-195 CONTROL TOTAL A
"RTN","ACRFIRS2",198,0)
 ;34 - 51 CONTROL TOTAL 2         196-213 CONTROL TOTAL B
"RTN","ACRFIRS2",199,0)
 ;52 - 69 CONTROL TOTAL 3         214-231 CONTROL TOTAL C
"RTN","ACRFIRS2",200,0)
 ;70 - 87 CONTROL TOTAL 4         232-748 BLANK
"RTN","ACRFIRS2",201,0)
 ;88 -105 CONTROL TOTAL 5         749-750 BLANK
"RTN","ACRFIRS2",202,0)
 ;106-123 CONTROL TOTAL 6
"RTN","ACRFIRS2",203,0)
 ;
"RTN","ACRFIRS2",204,0)
 ;      INPUT:
"RTN","ACRFIRS2",205,0)
 ;      ACRAREA = PAYER NAME
"RTN","ACRFIRS2",206,0)
 ;      ACRTOT( = ARRAY CONTAINING PAYMENT AMOUNT CODE TOTALS
"RTN","ACRFIRS2",207,0)
 ;      ACRCNTB = RECORD B COUNT
"RTN","ACRFIRS2",208,0)
 ;
"RTN","ACRFIRS2",209,0)
 N I,Z
"RTN","ACRFIRS2",210,0)
 S $E(Z)="C"
"RTN","ACRFIRS2",211,0)
 S $E(Z,2,9)=$$PAD^ACRFUTL(ACRCNTB,"L",8,0)
"RTN","ACRFIRS2",212,0)
 S $E(Z,10,15)=$$PAD^ACRFUTL("","R",6,"")
"RTN","ACRFIRS2",213,0)
 S $E(Z,16,33)=$$PAD^ACRFUTL(ACRTOT(1),"L",18,0)
"RTN","ACRFIRS2",214,0)
 S $E(Z,34,51)=$$PAD^ACRFUTL(ACRTOT(2),"L",18,0)
"RTN","ACRFIRS2",215,0)
 S $E(Z,52,69)=$$PAD^ACRFUTL(ACRTOT(3),"L",18,0)
"RTN","ACRFIRS2",216,0)
 S $E(Z,70,87)=$$PAD^ACRFUTL(ACRTOT(4),"L",18,0)
"RTN","ACRFIRS2",217,0)
 S $E(Z,88,105)=$$PAD^ACRFUTL(ACRTOT(5),"L",18,0)
"RTN","ACRFIRS2",218,0)
 S $E(Z,106,123)=$$PAD^ACRFUTL(ACRTOT(6),"L",18,0)
"RTN","ACRFIRS2",219,0)
 S $E(Z,124,141)=$$PAD^ACRFUTL(ACRTOT(7),"L",18,0)
"RTN","ACRFIRS2",220,0)
 S $E(Z,142,159)=$$PAD^ACRFUTL(ACRTOT(8),"L",18,0)
"RTN","ACRFIRS2",221,0)
 S $E(Z,160,177)=$$PAD^ACRFUTL(ACRTOT(9),"L",18,0)
"RTN","ACRFIRS2",222,0)
 S $E(Z,178,195)=$$PAD^ACRFUTL(ACRTOT("A"),"L",18,0)
"RTN","ACRFIRS2",223,0)
 S $E(Z,196,213)=$$PAD^ACRFUTL(ACRTOT("B"),"L",18,0)
"RTN","ACRFIRS2",224,0)
 S $E(Z,214,231)=$$PAD^ACRFUTL(ACRTOT("C"),"L",18,0)
"RTN","ACRFIRS2",225,0)
 S $E(Z,232,748)=$$PAD^ACRFUTL("","R",517,"")
"RTN","ACRFIRS2",226,0)
 S $E(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
"RTN","ACRFIRS2",227,0)
 ;
"RTN","ACRFIRS2",228,0)
 S ^TMP("ACRZ",$J,"RECORD","C",ACRAREA,1)=$E(Z,1,240)
"RTN","ACRFIRS2",229,0)
 S ^TMP("ACRZ",$J,"RECORD","C",ACRAREA,2)=$E(Z,241,480)
"RTN","ACRFIRS2",230,0)
 S ^TMP("ACRZ",$J,"RECORD","C",ACRAREA,3)=$E(Z,481,720)
"RTN","ACRFIRS2",231,0)
 S ^TMP("ACRZ",$J,"RECORD","C",ACRAREA,4)=$E(Z,721,750)
"RTN","ACRFIRS2",232,0)
 Q
"RTN","ACRFIRS2",233,0)
RECORDF(ACRCNTA)   ;EP
"RTN","ACRFIRS2",234,0)
 ;----- CREATE RECORD TYPE F (END OF TRANSMISSION)
"RTN","ACRFIRS2",235,0)
 ;
"RTN","ACRFIRS2",236,0)
 ;LAYOUT
"RTN","ACRFIRS2",237,0)
 ;1  -  1 "F"                    31 -748 BLANK
"RTN","ACRFIRS2",238,0)
 ;2  -  9 NUMBER OF A RECORDS    749-750 BLANK
"RTN","ACRFIRS2",239,0)
 ;10 - 30 ZEROS
"RTN","ACRFIRS2",240,0)
 ;
"RTN","ACRFIRS2",241,0)
 ;      INPUT:
"RTN","ACRFIRS2",242,0)
 ;      ACRCNTA = RECORD A COUNT
"RTN","ACRFIRS2",243,0)
 ;
"RTN","ACRFIRS2",244,0)
 N I,Z
"RTN","ACRFIRS2",245,0)
 S $E(Z)="F"
"RTN","ACRFIRS2",246,0)
 S $E(Z,2,9)=$$PAD^ACRFUTL(ACRCNTA,"L",8,0)
"RTN","ACRFIRS2",247,0)
 S $E(Z,10,30)=$$PAD^ACRFUTL("","L",21,0)
"RTN","ACRFIRS2",248,0)
 S $E(Z,31,748)=$$PAD^ACRFUTL("","R",718,"")
"RTN","ACRFIRS2",249,0)
 S $E(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
"RTN","ACRFIRS2",250,0)
 ;
"RTN","ACRFIRS2",251,0)
 S ^TMP("ACRZ",$J,"RECORD","F",1)=$E(Z,1,240)
"RTN","ACRFIRS2",252,0)
 S ^TMP("ACRZ",$J,"RECORD","F",2)=$E(Z,241,480)
"RTN","ACRFIRS2",253,0)
 S ^TMP("ACRZ",$J,"RECORD","F",3)=$E(Z,481,720)
"RTN","ACRFIRS2",254,0)
 S ^TMP("ACRZ",$J,"RECORD","F",4)=$E(Z,721,750)
"RTN","ACRFIRS2",255,0)
 Q
"RTN","ACRFIRS2",256,0)
RECORDT(ACRAREA,ACRPMYR,ACRCNTB)       ;EP
"RTN","ACRFIRS2",257,0)
 ;----- CREATE RECORD TYPE T  (TRANSMITTER)
"RTN","ACRFIRS2",258,0)
 ;
"RTN","ACRFIRS2",259,0)
 ;LAYOUT
"RTN","ACRFIRS2",260,0)
 ;1  -  1 "T"                       281-295 BLANK
"RTN","ACRFIRS2",261,0)
 ;2  -  5 PAYMENT YEAR              296-303 TOTAL NUMBER OF PAYEES
"RTN","ACRFIRS2",262,0)
 ;6  -  6 PRIOR YEAR DATA IND       304-343 CONTACT NAME
"RTN","ACRFIRS2",263,0)
 ;7  - 15 TRANSMITTER'S TIN         344-358 CONTACT PHONE
"RTN","ACRFIRS2",264,0)
 ;16 - 20 TRANSMITTER CTRL CODE     359-360 MAG TAPE FILE IND
"RTN","ACRFIRS2",265,0)
 ;21 - 22 REPLACEMENT ALPHA CHAR    361-375 ELEC FILE IND (BLANKS)
"RTN","ACRFIRS2",266,0)
 ;23 - 27 BLANK                     376-376 VENDOR INDICATOR ("I")
"RTN","ACRFIRS2",267,0)
 ;28 - 28 TEST FILE INDICATOR       377-416 VENDOR NAME OF COTS SF (NR)
"RTN","ACRFIRS2",268,0)
 ;29 - 29 FOREIGN ENTITY IND        417-456 VENDOR MAILING ADDRESS (NR)
"RTN","ACRFIRS2",269,0)
 ;30 - 69 TRANSMITTER NAME          457-496 VENDOR CITY (NR)
"RTN","ACRFIRS2",270,0)
 ;70 -109 TRANSMITTER NAME, CONT    497-498 VENDOR STATE (NR)
"RTN","ACRFIRS2",271,0)
 ;110-149 COMPANY NAME              499-507 VENDOR ZIP CODE (NR)
"RTN","ACRFIRS2",272,0)
 ;150-189 COMPANY NAME, CONT        508-547 VENDOR CONTACT NAME (NR)
"RTN","ACRFIRS2",273,0)
 ;190-229 COMPANY MAILING ADDR      548-562 VENDOR CONTACT PHONE (NR)
"RTN","ACRFIRS2",274,0)
 ;230-269 COMPANY CITY              563-582 VENDOR CONTACT EMAIL (NR)
"RTN","ACRFIRS2",275,0)
 ;270-271 COMPANY STATE             583-748 BLANK
"RTN","ACRFIRS2",276,0)
 ;272-280 COMPANY ZIP CODE          749-750 BLANK
"RTN","ACRFIRS2",277,0)
 ;
"RTN","ACRFIRS2",278,0)
 ;      INPUT:
"RTN","ACRFIRS2",279,0)
 ;      ACRAREA = PAYER NAME
"RTN","ACRFIRS2",280,0)
 ;      ACRPMYR = PAYMENT CALENDAR YEAR
"RTN","ACRFIRS2",281,0)
 ;      ACRCNTB = RECORD B COUNT
"RTN","ACRFIRS2",282,0)
 ;
"RTN","ACRFIRS2",283,0)
 N DATA,I,Z
"RTN","ACRFIRS2",284,0)
 S DATA=$G(^ACR1099P(ACRAREA,0))
"RTN","ACRFIRS2",285,0)
 S $E(Z)="T"
"RTN","ACRFIRS2",286,0)
 S $E(Z,2,5)=ACRPMYR
"RTN","ACRFIRS2",287,0)
 S $E(Z,6)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",288,0)
 S $E(Z,7,15)=$P(DATA,U,8)
"RTN","ACRFIRS2",289,0)
 S $E(Z,16,20)=$E($P(DATA,U,10),1,5)
"RTN","ACRFIRS2",290,0)
 S $E(Z,21,22)=$$PAD^ACRFUTL("","R",2,"")
"RTN","ACRFIRS2",291,0)
 S $E(Z,23,27)=$$PAD^ACRFUTL("","R",5,"")
"RTN","ACRFIRS2",292,0)
 S $E(Z,28)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",293,0)
 S $E(Z,29)=$$PAD^ACRFUTL("","R",1,"")
"RTN","ACRFIRS2",294,0)
 S $E(Z,30,69)=$$PAD^ACRFUTL($P(DATA,U,2),"R",40,"")
"RTN","ACRFIRS2",295,0)
 S $E(Z,70,109)=$$PAD^ACRFUTL($P(DATA,U,3),"R",40,"")
"RTN","ACRFIRS2",296,0)
 S $E(Z,110,149)=$$PAD^ACRFUTL($P(DATA,U,2),"R",40,"")
"RTN","ACRFIRS2",297,0)
 S $E(Z,150,189)=$$PAD^ACRFUTL($P(DATA,U,3),"R",40,"")
"RTN","ACRFIRS2",298,0)
 S $E(Z,190,229)=$$PAD^ACRFUTL($P(DATA,U,4),"R",40,"")
"RTN","ACRFIRS2",299,0)
 S $E(Z,230,269)=$$PAD^ACRFUTL($P(DATA,U,5),"R",40,"")
"RTN","ACRFIRS2",300,0)
 S $E(Z,270,271)=$P(^DIC(5,$P(DATA,U,6),0),U,2)
"RTN","ACRFIRS2",301,0)
 S $E(Z,272,280)=$$PAD^ACRFUTL($TR($P(DATA,U,7),"-",""),"R",9,"")
"RTN","ACRFIRS2",302,0)
 S $E(Z,281,295)=$$PAD^ACRFUTL("","R",15,"")
"RTN","ACRFIRS2",303,0)
 S $E(Z,296,303)=$$PAD^ACRFUTL(ACRCNTB,"L",8,0)
"RTN","ACRFIRS2",304,0)
 S $E(Z,304,343)=$$PAD^ACRFUTL($P(DATA,U,13),"R",40,"")
"RTN","ACRFIRS2",305,0)
 S $E(Z,344,358)=$$PAD^ACRFUTL($P(DATA,U,14),"R",15,"")
"RTN","ACRFIRS2",306,0)
 S $E(Z,359,360)=$$PAD^ACRFUTL("","R",2,"")
"RTN","ACRFIRS2",307,0)
 S $E(Z,361,375)=$$PAD^ACRFUTL("","R",15,"")
"RTN","ACRFIRS2",308,0)
 S $E(Z,376)="I"
"RTN","ACRFIRS2",309,0)
 S $E(Z,377,416)=$$PAD^ACRFUTL("","R",40,"")
"RTN","ACRFIRS2",310,0)
 S $E(Z,417,456)=$$PAD^ACRFUTL("","R",40,"")
"RTN","ACRFIRS2",311,0)
 S $E(Z,457,496)=$$PAD^ACRFUTL("","R",40,"")
"RTN","ACRFIRS2",312,0)
 S $E(Z,497,498)=$$PAD^ACRFUTL("","R",2,"")
"RTN","ACRFIRS2",313,0)
 S $E(Z,499,507)=$$PAD^ACRFUTL("","R",9,"")
"RTN","ACRFIRS2",314,0)
 S $E(Z,508,547)=$$PAD^ACRFUTL("","R",40,"")
"RTN","ACRFIRS2",315,0)
 S $E(Z,548,562)=$$PAD^ACRFUTL("","R",15,"")
"RTN","ACRFIRS2",316,0)
 S $E(Z,563,582)=$$PAD^ACRFUTL("","R",20,"")
"RTN","ACRFIRS2",317,0)
 S $E(Z,583,748)=$$PAD^ACRFUTL("","R",166,"")
"RTN","ACRFIRS2",318,0)
 S $E(Z,749,750)=$$PAD^ACRFUTL("","R",2,"")
"RTN","ACRFIRS2",319,0)
 ;
"RTN","ACRFIRS2",320,0)
 S ^TMP("ACRZ",$J,"RECORD","T",1)=$E(Z,1,240)
"RTN","ACRFIRS2",321,0)
 S ^TMP("ACRZ",$J,"RECORD","T",2)=$E(Z,241,480)
"RTN","ACRFIRS2",322,0)
 S ^TMP("ACRZ",$J,"RECORD","T",3)=$E(Z,481,720)
"RTN","ACRFIRS2",323,0)
 S ^TMP("ACRZ",$J,"RECORD","T",4)=$E(Z,721,750)
"RTN","ACRFIRS2",324,0)
 Q
"RTN","ACRFIRS6")
0^3^B148910949
"RTN","ACRFIRS6",1,0)
ACRFIRS6 ;IHS/OIRM/DSD/AEF - PRINT 1099s [ 01/15/2002  12:28 PM ]
"RTN","ACRFIRS6",2,0)
 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**1**;NOV 05, 2001
"RTN","ACRFIRS6",3,0)
 ;
"RTN","ACRFIRS6",4,0)
EN ;EP -- PRINT ALL VENDOR 1099S
"RTN","ACRFIRS6",5,0)
 ;
"RTN","ACRFIRS6",6,0)
 N ACRLOC,ACRYR,ZTSAVE
"RTN","ACRFIRS6",7,0)
 ;
"RTN","ACRFIRS6",8,0)
 D HOME^%ZIS
"RTN","ACRFIRS6",9,0)
 D ^XBKVAR
"RTN","ACRFIRS6",10,0)
 ;
"RTN","ACRFIRS6",11,0)
 D LOC(.ACRLOC)
"RTN","ACRFIRS6",12,0)
 Q:'$G(ACRLOC)
"RTN","ACRFIRS6",13,0)
 ;
"RTN","ACRFIRS6",14,0)
 D YR(.ACRYR)
"RTN","ACRFIRS6",15,0)
 Q:'$G(ACRYR)
"RTN","ACRFIRS6",16,0)
 ;
"RTN","ACRFIRS6",17,0)
 S ZTSAVE("ACRLOC")=""
"RTN","ACRFIRS6",18,0)
 S ZTSAVE("ACRYR")=""
"RTN","ACRFIRS6",19,0)
 D QUE^ACRFUTL("DQ^ACRFIRS6",.ZTSAVE,"PRINT 1099s")
"RTN","ACRFIRS6",20,0)
 ;
"RTN","ACRFIRS6",21,0)
 D ^%ZISC
"RTN","ACRFIRS6",22,0)
 Q
"RTN","ACRFIRS6",23,0)
DQ ;EP -- QUEUED JOB STARTS HERE
"RTN","ACRFIRS6",24,0)
 ;
"RTN","ACRFIRS6",25,0)
 ;      INCOMING VARIABLES:
"RTN","ACRFIRS6",26,0)
 ;      ACRLOC  = PAYER IEN
"RTN","ACRFIRS6",27,0)
 ;      ACRYR   = CALENDAR YEAR
"RTN","ACRFIRS6",28,0)
 ;
"RTN","ACRFIRS6",29,0)
 ;      OTHER VARIABLES USED:
"RTN","ACRFIRS6",30,0)
 ;      ACRTAMT = ARRAY CONTAINING AMOUNT TOTALS BY TYPE CODE
"RTN","ACRFIRS6",31,0)
 ;      ACRTCNT = ARRAY CONTAINING VENDOR COUNT BY TYPE CODE
"RTN","ACRFIRS6",32,0)
 ;
"RTN","ACRFIRS6",33,0)
 N ACRTAMT,ACRTCNT
"RTN","ACRFIRS6",34,0)
 ;
"RTN","ACRFIRS6",35,0)
 D ^XBKVAR
"RTN","ACRFIRS6",36,0)
 ;
"RTN","ACRFIRS6",37,0)
 D LOOP(ACRLOC,ACRYR,.ACRTAMT,.ACRTCNT)
"RTN","ACRFIRS6",38,0)
 ;
"RTN","ACRFIRS6",39,0)
 D TOTALS(.ACRTAMT,.ACRTCNT)
"RTN","ACRFIRS6",40,0)
 ;
"RTN","ACRFIRS6",41,0)
 K ACRLOC,ACRYR
"RTN","ACRFIRS6",42,0)
 ;
"RTN","ACRFIRS6",43,0)
 D ^%ZISC
"RTN","ACRFIRS6",44,0)
 Q
"RTN","ACRFIRS6",45,0)
LOOP(ACRLOC,ACRYR,ACRTAMT,ACRTCNT)     ;
"RTN","ACRFIRS6",46,0)
 ;----- LOOP THROUGH ARMS VENDOR FILE AND PRINT 1099s
"RTN","ACRFIRS6",47,0)
 ;
"RTN","ACRFIRS6",48,0)
 ;      INPUT:
"RTN","ACRFIRS6",49,0)
 ;      ACRLOC  = PAYER IEN
"RTN","ACRFIRS6",50,0)
 ;      ACRYR   = CALENDAR YEAR
"RTN","ACRFIRS6",51,0)
 ;
"RTN","ACRFIRS6",52,0)
 ;      RETURNS:
"RTN","ACRFIRS6",53,0)
 ;      ACRTAMT = ARRAY CONTAINING PAYMENT AMOUNTS BY TYPE CODE
"RTN","ACRFIRS6",54,0)
 ;      ACRTCNT = ARRAY CONTAINING VENDOR COUNTS BY TYPE CODE
"RTN","ACRFIRS6",55,0)
 ;
"RTN","ACRFIRS6",56,0)
 N ACRCNT,ACRNAME,ACRVEN
"RTN","ACRFIRS6",57,0)
 ;
"RTN","ACRFIRS6",58,0)
 K ^TMP("ACR1099",$J)
"RTN","ACRFIRS6",59,0)
 ;
"RTN","ACRFIRS6",60,0)
 D ALPHA(ACRYR)
"RTN","ACRFIRS6",61,0)
 Q:'$D(^TMP("ACR1099",$J))
"RTN","ACRFIRS6",62,0)
 ;
"RTN","ACRFIRS6",63,0)
 S ACRCNT=0
"RTN","ACRFIRS6",64,0)
 S ACRNAME=""
"RTN","ACRFIRS6",65,0)
 F  S ACRNAME=$O(^TMP("ACR1099",$J,ACRNAME)) Q:ACRNAME']""  D
"RTN","ACRFIRS6",66,0)
 . S ACRVEN=0 F  S ACRVEN=$O(^TMP("ACR1099",$J,ACRNAME,ACRVEN)) Q:'ACRVEN  D
"RTN","ACRFIRS6",67,0)
 . . Q:$$AMT(ACRVEN,ACRYR)<600
"RTN","ACRFIRS6",68,0)
 . . S ACRCNT=ACRCNT+1
"RTN","ACRFIRS6",69,0)
 . . I ACRCNT>1,ACRCNT#2 W @IOF
"RTN","ACRFIRS6",70,0)
 . . D PRT(ACRVEN,ACRLOC,ACRYR,ACRCNT,.ACRTAMT,.ACRTCNT)
"RTN","ACRFIRS6",71,0)
 . . D UPDATE(ACRVEN,ACRYR)
"RTN","ACRFIRS6",72,0)
 ;
"RTN","ACRFIRS6",73,0)
 K ^TMP("ACR1099",$J)
"RTN","ACRFIRS6",74,0)
 Q
"RTN","ACRFIRS6",75,0)
ALPHA(ACRYR)       ;
"RTN","ACRFIRS6",76,0)
 ;----- BUILD ALPHABETIC ARRAY OF VENDORS IN ^TMP("ACR1099",$J)
"RTN","ACRFIRS6",77,0)
 ;
"RTN","ACRFIRS6",78,0)
 ;      INPUT:
"RTN","ACRFIRS6",79,0)
 ;      ACRYR   = CALENDAR YEAR
"RTN","ACRFIRS6",80,0)
 ;
"RTN","ACRFIRS6",81,0)
 N ACRNAME,ACRVEN
"RTN","ACRFIRS6",82,0)
 S ACRVEN=0
"RTN","ACRFIRS6",83,0)
 F  S ACRVEN=$O(^ACR1099V("C",ACRYR,ACRVEN)) Q:'ACRVEN  D
"RTN","ACRFIRS6",84,0)
 . S ACRNAME=$P(^AUTTVNDR(ACRVEN,0),U)
"RTN","ACRFIRS6",85,0)
 . S ^TMP("ACR1099",$J,ACRNAME,ACRVEN)=0
"RTN","ACRFIRS6",86,0)
 Q
"RTN","ACRFIRS6",87,0)
PRT(ACRVEN,ACRLOC,ACRYR,ACRCNT,ACRTAMT,ACRTCNT)  ;
"RTN","ACRFIRS6",88,0)
 ;----- PRINT VENDOR 1099
"RTN","ACRFIRS6",89,0)
 ;
"RTN","ACRFIRS6",90,0)
 ;      INPUT:
"RTN","ACRFIRS6",91,0)
 ;      ACRVEN  = VENDOR IEN
"RTN","ACRFIRS6",92,0)
 ;      ACRLOC  = PAYER IEN
"RTN","ACRFIRS6",93,0)
 ;      ACRYR   = CALENDAR YEAR
"RTN","ACRFIRS6",94,0)
 ;
"RTN","ACRFIRS6",95,0)
 ;      RETURNS:
"RTN","ACRFIRS6",96,0)
 ;      ACRTAMT = ARRAY CONTAINING AMOUNT TOTALS BY TYPE CODE
"RTN","ACRFIRS6",97,0)
 ;      ACRTCNT = ARRAY CONTAINING COUNT TOTALS BY TYPE CODE
"RTN","ACRFIRS6",98,0)
 ;
"RTN","ACRFIRS6",99,0)
 ;      VARIABLES SET AND USED BY THIS SUBROUTINE:
"RTN","ACRFIRS6",100,0)
 ;      ACRAMT  = ARRAY CONTAINING PAYMENT AMOUNTS BY TYPE CODE
"RTN","ACRFIRS6",101,0)
 ;      ACRCOR  = CORRECTED RETURN INDICATOR
"RTN","ACRFIRS6",102,0)
 ;      ACRIRS  = PAYER IRS NAME
"RTN","ACRFIRS6",103,0)
 ;      ACRPADD = ARRAY CONTAINING PAYER ADDRESS
"RTN","ACRFIRS6",104,0)
 ;      ACRPSN  = PAYER STATE NUMBER
"RTN","ACRFIRS6",105,0)
 ;      ACRPTIN = PAYER TAX ID NUMBER
"RTN","ACRFIRS6",106,0)
 ;      ACRTYP  = PAYMENT TYPE CODE
"RTN","ACRFIRS6",107,0)
 ;      ACRVADD = ARRAY CONTAINING VENDOR ADDRESS
"RTN","ACRFIRS6",108,0)
 ;      ACRVTIN = VENDOR TAX ID NUMBER
"RTN","ACRFIRS6",109,0)
 ;
"RTN","ACRFIRS6",110,0)
 ;
"RTN","ACRFIRS6",111,0)
 ;----- SET VARIABLES
"RTN","ACRFIRS6",112,0)
 ;
"RTN","ACRFIRS6",113,0)
 N ACRAMT,ACRCOR,ACRIRS,ACRPADD,ACRPSN,ACRPTIN,ACRTYP,ACRVADD,ACRVTIN,DATA
"RTN","ACRFIRS6",114,0)
 ;
"RTN","ACRFIRS6",115,0)
 F I=1:1:8,"A","B","C" S ACRAMT(I)=""
"RTN","ACRFIRS6",116,0)
 S ACRCOR=""
"RTN","ACRFIRS6",117,0)
 I $P($G(^ACR1099V(ACRVEN,1,ACRYR,0)),U,6)="Y" S ACRCOR="X"
"RTN","ACRFIRS6",118,0)
 S DATA=^ACR1099V(ACRVEN,0)
"RTN","ACRFIRS6",119,0)
 S ACRTYP=$P(DATA,U,2)
"RTN","ACRFIRS6",120,0)
 S ACRIRS=$P(DATA,U,3)
"RTN","ACRFIRS6",121,0)
 S ACRAMT(ACRTYP)=$$AMT(ACRVEN,ACRYR)
"RTN","ACRFIRS6",122,0)
 D PADD(ACRLOC,.ACRPADD)
"RTN","ACRFIRS6",123,0)
 D VADD(ACRVEN,ACRIRS,.ACRVADD)
"RTN","ACRFIRS6",124,0)
 S ACRPTIN=$P(^ACR1099P(ACRLOC,0),U,8)
"RTN","ACRFIRS6",125,0)
 S ACRVTIN=$E($P(^AUTTVNDR(ACRVEN,11),U),2,10)
"RTN","ACRFIRS6",126,0)
 S ACRPSN=$P($G(^ACR1099P(ACRLOC,1)),U)
"RTN","ACRFIRS6",127,0)
 ;
"RTN","ACRFIRS6",128,0)
 ;----- PRINT INDIVIDUAL LINES
"RTN","ACRFIRS6",129,0)
 ;
"RTN","ACRFIRS6",130,0)
 ;LINE2 BLANK
"RTN","ACRFIRS6",131,0)
 ;W !
"RTN","ACRFIRS6",132,0)
 ;         
"RTN","ACRFIRS6",133,0)
 ;LINE3 CORRECTED RETURN INDICATOR
"RTN","ACRFIRS6",134,0)
 ;W !
"RTN","ACRFIRS6",135,0)
 W ?30,ACRCOR
"RTN","ACRFIRS6",136,0)
 ;
"RTN","ACRFIRS6",137,0)
 ;LINE4 BLANK
"RTN","ACRFIRS6",138,0)
 W !
"RTN","ACRFIRS6",139,0)
 ;
"RTN","ACRFIRS6",140,0)
 ;LINE5 PAYER'S NAME
"RTN","ACRFIRS6",141,0)
 W !
"RTN","ACRFIRS6",142,0)
 W ?5,ACRPADD(1)
"RTN","ACRFIRS6",143,0)
 ;
"RTN","ACRFIRS6",144,0)
 ;LINE6 PAYER'S ADDRESS LINE 1 / RENTS AMOUNT
"RTN","ACRFIRS6",145,0)
 W !
"RTN","ACRFIRS6",146,0)
 W ?5,ACRPADD(2)
"RTN","ACRFIRS6",147,0)
 W ?39,$J(ACRAMT(1),12,2)
"RTN","ACRFIRS6",148,0)
 ;
"RTN","ACRFIRS6",149,0)
 ;LINE7 PAYER'S ADDRESS LINE 2
"RTN","ACRFIRS6",150,0)
 W !
"RTN","ACRFIRS6",151,0)
 W ?5,ACRPADD(3)
"RTN","ACRFIRS6",152,0)
 ;
"RTN","ACRFIRS6",153,0)
 ;LINE8 PAYER'S CITY,STATE,ZIP
"RTN","ACRFIRS6",154,0)
 W !
"RTN","ACRFIRS6",155,0)
 W ?5,ACRPADD(4)
"RTN","ACRFIRS6",156,0)
 ;
"RTN","ACRFIRS6",157,0)
 ;LINE9 ROYALTIES AMOUNT
"RTN","ACRFIRS6",158,0)
 W !
"RTN","ACRFIRS6",159,0)
 W ?39,$J(ACRAMT(2),12,2)
"RTN","ACRFIRS6",160,0)
 ;
"RTN","ACRFIRS6",161,0)
 ;LINE10 BLANK
"RTN","ACRFIRS6",162,0)
 W !
"RTN","ACRFIRS6",163,0)
 ;
"RTN","ACRFIRS6",164,0)
 ;LINE11 OTHER INCOME AMOUNT / FEDERAL INCOME TAX WHLD AMOUNT
"RTN","ACRFIRS6",165,0)
 W !
"RTN","ACRFIRS6",166,0)
 W ?39,$J(ACRAMT(3),12,2)
"RTN","ACRFIRS6",167,0)
 W ?53,$J(ACRAMT(4),12,2)
"RTN","ACRFIRS6",168,0)
 ;
"RTN","ACRFIRS6",169,0)
 ;LINE12 BLANK
"RTN","ACRFIRS6",170,0)
 W !
"RTN","ACRFIRS6",171,0)
 ;
"RTN","ACRFIRS6",172,0)
 ;LINE13 BLANK  
"RTN","ACRFIRS6",173,0)
 W !
"RTN","ACRFIRS6",174,0)
 ;
"RTN","ACRFIRS6",175,0)
 ;LINE14 BLANK     
"RTN","ACRFIRS6",176,0)
 W !
"RTN","ACRFIRS6",177,0)
 ;
"RTN","ACRFIRS6",178,0)
 ;LINE15 PAYER TIN / PAYEE TIN / FISHING BOAT AMOUNT / MEDICAL AMOUNT
"RTN","ACRFIRS6",179,0)
 W !
"RTN","ACRFIRS6",180,0)
 W ?5,ACRPTIN
"RTN","ACRFIRS6",181,0)
 W ?25,ACRVTIN
"RTN","ACRFIRS6",182,0)
 W ?39,$J(ACRAMT(5),12,2)
"RTN","ACRFIRS6",183,0)
 W ?53,$J(ACRAMT(6),12,2)
"RTN","ACRFIRS6",184,0)
 ;
"RTN","ACRFIRS6",185,0)
 ;LINE16 BLANK
"RTN","ACRFIRS6",186,0)
 W !
"RTN","ACRFIRS6",187,0)
 ;
"RTN","ACRFIRS6",188,0)
 ;LINE17 PAYEE'S NAME
"RTN","ACRFIRS6",189,0)
 W !
"RTN","ACRFIRS6",190,0)
 W ?5,ACRVADD(1)
"RTN","ACRFIRS6",191,0)
 ;
"RTN","ACRFIRS6",192,0)
 ;LINE18 BLANK
"RTN","ACRFIRS6",193,0)
 W !
"RTN","ACRFIRS6",194,0)
 ;
"RTN","ACRFIRS6",195,0)
 ;LINE19 NONEMPLOYEE COMP AMOUNT / SUBSTITUTE PMT AMOUNT
"RTN","ACRFIRS6",196,0)
 W !
"RTN","ACRFIRS6",197,0)
 W ?39,$J(ACRAMT(7),12,2)
"RTN","ACRFIRS6",198,0)
 W ?53,$J(ACRAMT(8),12,2)
"RTN","ACRFIRS6",199,0)
 ;
"RTN","ACRFIRS6",200,0)
 ;LINE20 BLANK
"RTN","ACRFIRS6",201,0)
 W !
"RTN","ACRFIRS6",202,0)
 ;
"RTN","ACRFIRS6",203,0)
 ;LINE21 PAYEE ADDRESS LINE 1
"RTN","ACRFIRS6",204,0)
 W !
"RTN","ACRFIRS6",205,0)
 W ?5,ACRVADD(2)
"RTN","ACRFIRS6",206,0)
 ;
"RTN","ACRFIRS6",207,0)
 ;LINE22 PAYEE ADDRESS LINE 2 / CROP INSURANCE AMOUNT
"RTN","ACRFIRS6",208,0)
 W !
"RTN","ACRFIRS6",209,0)
 W ?5,ACRVADD(3)
"RTN","ACRFIRS6",210,0)
 W ?53,$J(ACRAMT("A"),12,2)
"RTN","ACRFIRS6",211,0)
 ;
"RTN","ACRFIRS6",212,0)
 ;LINE23 BLANK
"RTN","ACRFIRS6",213,0)
 W !
"RTN","ACRFIRS6",214,0)
 ;
"RTN","ACRFIRS6",215,0)
 ;LINE24 PAYEE CITY,STATE,ZIP
"RTN","ACRFIRS6",216,0)
 W !
"RTN","ACRFIRS6",217,0)
 W ?5,ACRVADD(4)
"RTN","ACRFIRS6",218,0)
 ;
"RTN","ACRFIRS6",219,0)
 ;LINE25 BLANK
"RTN","ACRFIRS6",220,0)
 W !
"RTN","ACRFIRS6",221,0)
 ;
"RTN","ACRFIRS6",222,0)
 ;LINE26 BLANK   
"RTN","ACRFIRS6",223,0)
 W !
"RTN","ACRFIRS6",224,0)
 ;
"RTN","ACRFIRS6",225,0)
 ;LINE27 GOLDEN PARACHUTE AMOUNT / PROCEEDS TO ATTORNEY AMOUNT
"RTN","ACRFIRS6",226,0)
 W !
"RTN","ACRFIRS6",227,0)
 W ?39,$J(ACRAMT("B"),12,2)
"RTN","ACRFIRS6",228,0)
 W ?53,$J(ACRAMT("C"),12,2)
"RTN","ACRFIRS6",229,0)
 ;
"RTN","ACRFIRS6",230,0)
 ;LINE28 BLANK
"RTN","ACRFIRS6",231,0)
 W !
"RTN","ACRFIRS6",232,0)
 ;
"RTN","ACRFIRS6",233,0)
 ;LINE29 STATE/PAYER'S STATE NO.
"RTN","ACRFIRS6",234,0)
 W !
"RTN","ACRFIRS6",235,0)
 W ?55,ACRPSN
"RTN","ACRFIRS6",236,0)
 ;
"RTN","ACRFIRS6",237,0)
 ;LINE30 BLANK  
"RTN","ACRFIRS6",238,0)
 W !
"RTN","ACRFIRS6",239,0)
 ;
"RTN","ACRFIRS6",240,0)
 I $G(ACRCNT)#2 F I=1:1:6 W !
"RTN","ACRFIRS6",241,0)
 ;
"RTN","ACRFIRS6",242,0)
 ;----- SET DOLLAR AMOUNT ARRAY
"RTN","ACRFIRS6",243,0)
 ;
"RTN","ACRFIRS6",244,0)
 S ACRTAMT(ACRTYP)=$G(ACRTAMT(ACRTYP))+ACRAMT(ACRTYP)
"RTN","ACRFIRS6",245,0)
 S ACRTCNT(ACRTYP)=$G(ACRTCNT(ACRTYP))+1
"RTN","ACRFIRS6",246,0)
 Q
"RTN","ACRFIRS6",247,0)
LOC(ACRLOC)        ;
"RTN","ACRFIRS6",248,0)
 ;----- ASK FINANCE LOCATION
"RTN","ACRFIRS6",249,0)
 ;
"RTN","ACRFIRS6",250,0)
 ;      RETURNS:
"RTN","ACRFIRS6",251,0)
 ;      ACRLOC  = PAYER IEN
"RTN","ACRFIRS6",252,0)
 ;
"RTN","ACRFIRS6",253,0)
 N DIC,DTOUT,DUOUT,X,Y
"RTN","ACRFIRS6",254,0)
 S DIC="^ACR1099P("
"RTN","ACRFIRS6",255,0)
 S DIC(0)="AEMQ"
"RTN","ACRFIRS6",256,0)
 S DIC("A")="Select FINANCE LOCATION: "
"RTN","ACRFIRS6",257,0)
 D ^DIC
"RTN","ACRFIRS6",258,0)
 Q:$D(DTOUT)!($D(DUOUT))
"RTN","ACRFIRS6",259,0)
 Q:+Y'>0
"RTN","ACRFIRS6",260,0)
 S ACRLOC=+Y
"RTN","ACRFIRS6",261,0)
 Q
"RTN","ACRFIRS6",262,0)
YR(ACRYR)          ;
"RTN","ACRFIRS6",263,0)
 ;----- ASK CALENDAR YEAR
"RTN","ACRFIRS6",264,0)
 ;
"RTN","ACRFIRS6",265,0)
 ;      RETURNS:
"RTN","ACRFIRS6",266,0)
 ;      ACRYR   = CALENDAR YEAR
"RTN","ACRFIRS6",267,0)
 ;
"RTN","ACRFIRS6",268,0)
 N DIR,DIRUT,DTOUT,DUOUT,X,Y
"RTN","ACRFIRS6",269,0)
 S DIR(0)="N^0000:9999"
"RTN","ACRFIRS6",270,0)
 S DIR("A")="Select CALENDAR YEAR"
"RTN","ACRFIRS6",271,0)
 S DIR("B")=($E(DT,1,3)+1700)-1
"RTN","ACRFIRS6",272,0)
 D ^DIR
"RTN","ACRFIRS6",273,0)
 Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
"RTN","ACRFIRS6",274,0)
 Q:+Y'>0
"RTN","ACRFIRS6",275,0)
 S ACRYR=+Y
"RTN","ACRFIRS6",276,0)
 Q
"RTN","ACRFIRS6",277,0)
VEN(ACRVEN)        ;
"RTN","ACRFIRS6",278,0)
 ;----- ASK VENDOR
"RTN","ACRFIRS6",279,0)
 ;
"RTN","ACRFIRS6",280,0)
 ;      RETURNS:
"RTN","ACRFIRS6",281,0)
 ;      ACRVEN  = VENDOR IEN
"RTN","ACRFIRS6",282,0)
 ;
"RTN","ACRFIRS6",283,0)
 N DIC,DTOUT,DUOUT,X,Y
"RTN","ACRFIRS6",284,0)
 S DIC="^ACR1099V("
"RTN","ACRFIRS6",285,0)
 S DIC(0)="AEMQ"
"RTN","ACRFIRS6",286,0)
 S DIC("A")="Select VENDOR: "
"RTN","ACRFIRS6",287,0)
 D ^DIC
"RTN","ACRFIRS6",288,0)
 Q:$D(DTOUT)!($D(DUOUT))
"RTN","ACRFIRS6",289,0)
 Q:+Y'>0
"RTN","ACRFIRS6",290,0)
 S ACRVEN=+Y
"RTN","ACRFIRS6",291,0)
 Q
"RTN","ACRFIRS6",292,0)
UPDATE(ACRVEN,ACRYR)         ;
"RTN","ACRFIRS6",293,0)
 ;----- UPDATE 1099 PRINT DATE FIELD IN ARMS 1099 VENDOR FILE
"RTN","ACRFIRS6",294,0)
 ;
"RTN","ACRFIRS6",295,0)
 ;      INPUT:
"RTN","ACRFIRS6",296,0)
 ;      ACRVEN  = VENDOR IEN
"RTN","ACRFIRS6",297,0)
 ;      ACRYR   = CALENDAR YEAR
"RTN","ACRFIRS6",298,0)
 ;
"RTN","ACRFIRS6",299,0)
 N DA,DIE,DR,X,Y
"RTN","ACRFIRS6",300,0)
 S DA(1)=ACRVEN
"RTN","ACRFIRS6",301,0)
 S DA=ACRYR
"RTN","ACRFIRS6",302,0)
 S DIE="^ACR1099V("_DA(1)_",1,"
"RTN","ACRFIRS6",303,0)
 S DR=".05////"_DT
"RTN","ACRFIRS6",304,0)
 D ^DIE
"RTN","ACRFIRS6",305,0)
 Q
"RTN","ACRFIRS6",306,0)
ONE ;EP -- PRINT ONE VENDOR 1099
"RTN","ACRFIRS6",307,0)
 ;
"RTN","ACRFIRS6",308,0)
 N ACRLOC,ACRVEN,ACRYR,ZTSAVE
"RTN","ACRFIRS6",309,0)
 ;
"RTN","ACRFIRS6",310,0)
 D HOME^%ZIS
"RTN","ACRFIRS6",311,0)
 D ^XBKVAR
"RTN","ACRFIRS6",312,0)
 ;
"RTN","ACRFIRS6",313,0)
 D LOC(.ACRLOC)
"RTN","ACRFIRS6",314,0)
 Q:'$G(ACRLOC)
"RTN","ACRFIRS6",315,0)
 ;
"RTN","ACRFIRS6",316,0)
 D YR(.ACRYR)
"RTN","ACRFIRS6",317,0)
 Q:'$G(ACRYR)
"RTN","ACRFIRS6",318,0)
 ;
"RTN","ACRFIRS6",319,0)
 D VEN(.ACRVEN)
"RTN","ACRFIRS6",320,0)
 Q:'$G(ACRVEN)
"RTN","ACRFIRS6",321,0)
 ;
"RTN","ACRFIRS6",322,0)
 S ZTSAVE("ACRLOC")=""
"RTN","ACRFIRS6",323,0)
 S ZTSAVE("ACRYR")=""
"RTN","ACRFIRS6",324,0)
 S ZTSAVE("ACRVEN")=""
"RTN","ACRFIRS6",325,0)
 D QUE^ACRFUTL("DQ1^ACRFIRS6",.ZTSAVE,"PRINT ONE 1099")
"RTN","ACRFIRS6",326,0)
 ;
"RTN","ACRFIRS6",327,0)
 D ^%ZISC
"RTN","ACRFIRS6",328,0)
 Q
"RTN","ACRFIRS6",329,0)
DQ1 ;EP -- QUEUED JOB STARTS HERE
"RTN","ACRFIRS6",330,0)
 ;
"RTN","ACRFIRS6",331,0)
 ;      INPUT:
"RTN","ACRFIRS6",332,0)
 ;      ACRLOC  = PAYER IEN
"RTN","ACRFIRS6",333,0)
 ;      ACRVEN  = VENDOR IEN
"RTN","ACRFIRS6",334,0)
 ;      ACRYR   = CALENDAR YEAR
"RTN","ACRFIRS6",335,0)
 ;
"RTN","ACRFIRS6",336,0)
 N ACRMTOT,ACRMAMT,ACRNTOT,ACRNAMT
"RTN","ACRFIRS6",337,0)
 ;
"RTN","ACRFIRS6",338,0)
 W @IOF
"RTN","ACRFIRS6",339,0)
 ;
"RTN","ACRFIRS6",340,0)
 D ^XBKVAR
"RTN","ACRFIRS6",341,0)
 ;
"RTN","ACRFIRS6",342,0)
 D PRT(ACRVEN,ACRLOC,ACRYR,$G(ACRCNT),.ACRTAMT,.ACRTCNT)
"RTN","ACRFIRS6",343,0)
 ;
"RTN","ACRFIRS6",344,0)
 D TOTALS(.ACRTAMT,.ACRTCNT)
"RTN","ACRFIRS6",345,0)
 ;
"RTN","ACRFIRS6",346,0)
 D ^%ZISC
"RTN","ACRFIRS6",347,0)
 K ACRLOC,ACRVEN,ACRYR
"RTN","ACRFIRS6",348,0)
 Q
"RTN","ACRFIRS6",349,0)
TEST ;EP -- PRINT TEST 1099s
"RTN","ACRFIRS6",350,0)
 ;
"RTN","ACRFIRS6",351,0)
 N ACRLOC,ACRYR,ZTSAVE
"RTN","ACRFIRS6",352,0)
 ;
"RTN","ACRFIRS6",353,0)
 D ^XBKVAR
"RTN","ACRFIRS6",354,0)
 ;
"RTN","ACRFIRS6",355,0)
 D LOC(.ACRLOC)
"RTN","ACRFIRS6",356,0)
 Q:'$G(ACRLOC)
"RTN","ACRFIRS6",357,0)
 ;
"RTN","ACRFIRS6",358,0)
 D YR(.ACRYR)
"RTN","ACRFIRS6",359,0)
 Q:'$G(ACRYR)
"RTN","ACRFIRS6",360,0)
 ;
"RTN","ACRFIRS6",361,0)
 S ZTSAVE("ACRLOC")=""
"RTN","ACRFIRS6",362,0)
 S ZTSAVE("ACRYR")=""
"RTN","ACRFIRS6",363,0)
 D QUE^ACRFUTL("DQ2^ACRFIRS6",.ZTSAVE,"PRINT TEST 1099s")
"RTN","ACRFIRS6",364,0)
 ;
"RTN","ACRFIRS6",365,0)
 D ^%ZISC
"RTN","ACRFIRS6",366,0)
 Q
"RTN","ACRFIRS6",367,0)
DQ2 ;EP -- QUEUED JOB STARTS HERE
"RTN","ACRFIRS6",368,0)
 ;
"RTN","ACRFIRS6",369,0)
 ;      INPUT:
"RTN","ACRFIRS6",370,0)
 ;      ACRLOC  = PAYER IEN
"RTN","ACRFIRS6",371,0)
 ;      ACRYR   = CALENDAR YEAR
"RTN","ACRFIRS6",372,0)
 ;
"RTN","ACRFIRS6",373,0)
 N ACRTAMT,ACRTCNT,ACRVEN,ACRCNT
"RTN","ACRFIRS6",374,0)
 ;
"RTN","ACRFIRS6",375,0)
 W @IOF
"RTN","ACRFIRS6",376,0)
 ;
"RTN","ACRFIRS6",377,0)
 D ^XBKVAR
"RTN","ACRFIRS6",378,0)
 ;
"RTN","ACRFIRS6",379,0)
 S (ACRVEN,ACRCNT)=0
"RTN","ACRFIRS6",380,0)
 F  Q:ACRCNT>9  S ACRVEN=$O(^ACR1099V("C",ACRYR,ACRVEN)) Q:'ACRVEN  D
"RTN","ACRFIRS6",381,0)
 . S ACRCNT=ACRCNT+1
"RTN","ACRFIRS6",382,0)
 . Q:ACRCNT>9
"RTN","ACRFIRS6",383,0)
 . I ACRCNT>1,ACRCNT#2 W @IOF
"RTN","ACRFIRS6",384,0)
 . D PRT(ACRVEN,ACRLOC,ACRYR,ACRCNT,.ACRTAMT,.ACRTCNT)
"RTN","ACRFIRS6",385,0)
 ;
"RTN","ACRFIRS6",386,0)
 D TOTALS(.ACRTAMT,.ACRTCNT)
"RTN","ACRFIRS6",387,0)
 ;
"RTN","ACRFIRS6",388,0)
 K ACRLOC,ACRYR
"RTN","ACRFIRS6",389,0)
 D ^%ZISC
"RTN","ACRFIRS6",390,0)
 Q
"RTN","ACRFIRS6",391,0)
RANGE ;EP -- PRINT RANGE OF VENDOR 1099S
"RTN","ACRFIRS6",392,0)
 ;
"RTN","ACRFIRS6",393,0)
 N ACRLOC,ACRVEN,ACRYR,ZTSAVE
"RTN","ACRFIRS6",394,0)
 ;
"RTN","ACRFIRS6",395,0)
 D ^XBKVAR
"RTN","ACRFIRS6",396,0)
 ;
"RTN","ACRFIRS6",397,0)
 K ^TMP("ACR1099",$J)
"RTN","ACRFIRS6",398,0)
 ;
"RTN","ACRFIRS6",399,0)
 D LOC(.ACRLOC)
"RTN","ACRFIRS6",400,0)
 Q:'$G(ACRLOC)
"RTN","ACRFIRS6",401,0)
 ;
"RTN","ACRFIRS6",402,0)
 D YR(.ACRYR)
"RTN","ACRFIRS6",403,0)
 Q:'$G(ACRYR)
"RTN","ACRFIRS6",404,0)
 ;
"RTN","ACRFIRS6",405,0)
 D ALPHA(ACRYR)
"RTN","ACRFIRS6",406,0)
 I '$D(^TMP("ACR1099",$J)) D  G RANGE
"RTN","ACRFIRS6",407,0)
 . W !,"No Vendor data found for ",ACRYR
"RTN","ACRFIRS6",408,0)
 ;
"RTN","ACRFIRS6",409,0)
 D VEND(.ACRVEN)
"RTN","ACRFIRS6",410,0)
 Q:ACRVEN']""
"RTN","ACRFIRS6",411,0)
 ;
"RTN","ACRFIRS6",412,0)
 S ZTSAVE("ACRLOC")=""
"RTN","ACRFIRS6",413,0)
 S ZTSAVE("ACRYR")=""
"RTN","ACRFIRS6",414,0)
 S ZTSAVE("ACRVEN")=""
"RTN","ACRFIRS6",415,0)
 D QUE^ACRFUTL("DQ3^ACRFIRS6",.ZTSAVE,"PRINT RANGE OF 1099S")
"RTN","ACRFIRS6",416,0)
 ;
"RTN","ACRFIRS6",417,0)
 D ^%ZISC
"RTN","ACRFIRS6",418,0)
 Q
"RTN","ACRFIRS6",419,0)
DQ3 ;EP -- QUEUED JOB STARTS HERE
"RTN","ACRFIRS6",420,0)
 ;
"RTN","ACRFIRS6",421,0)
 ;      INPUT:
"RTN","ACRFIRS6",422,0)
 ;      ACRLOC  = PAYER IEN
"RTN","ACRFIRS6",423,0)
 ;      ACRVEN  = VENDOR RANGE
"RTN","ACRFIRS6",424,0)
 ;      ACRYR   = CALENDAR YEAR
"RTN","ACRFIRS6",425,0)
 ;
"RTN","ACRFIRS6",426,0)
 N ACRTAMT,ACRTCNT
"RTN","ACRFIRS6",427,0)
 ;
"RTN","ACRFIRS6",428,0)
 D ^XBKVAR
"RTN","ACRFIRS6",429,0)
 ;
"RTN","ACRFIRS6",430,0)
 D LOOP3(ACRLOC,ACRYR,ACRVEN,.ACRTAMT,.ACRTCNT)
"RTN","ACRFIRS6",431,0)
 ;
"RTN","ACRFIRS6",432,0)
 K ACRLOC,ACRYR,ACRVEN
"RTN","ACRFIRS6",433,0)
 D ^%ZISC
"RTN","ACRFIRS6",434,0)
 Q
"RTN","ACRFIRS6",435,0)
LOOP3(ACRLOC,ACRYR,ACRVEN,ACRTAMT,ACRTCNT)       ;
"RTN","ACRFIRS6",436,0)
 ;
"RTN","ACRFIRS6",437,0)
 ;     INPUT:
"RTN","ACRFIRS6",438,0)
 ;     ACRLOC  = PAYER IEN
"RTN","ACRFIRS6",439,0)
 ;     ACRVEN  = VENDOR RANGE
"RTN","ACRFIRS6",440,0)
 ;     ACRYR   = CALENDAR YEAR
"RTN","ACRFIRS6",441,0)
 ;
"RTN","ACRFIRS6",442,0)
 ;     RETURNS:
"RTN","ACRFIRS6",443,0)
 ;     ACRTAMT = ARRAY CONTAINING AMOUNTS BY PAYMENT TYPE CODE
"RTN","ACRFIRS6",444,0)
 ;     ACRTCNT = ARRAY CONTAINING VENDOR COUNTS BY PAYMENT TYPE CODE
"RTN","ACRFIRS6",445,0)
 ;
"RTN","ACRFIRS6",446,0)
 N ACREND,ACRNAME,ACRCNT
"RTN","ACRFIRS6",447,0)
 ;
"RTN","ACRFIRS6",448,0)
 D ALPHA(ACRYR)
"RTN","ACRFIRS6",449,0)
 Q:'$D(^TMP("ACR1099",$J))
"RTN","ACRFIRS6",450,0)
 ;
"RTN","ACRFIRS6",451,0)
 S ACREND=$P(ACRVEN,U,2)
"RTN","ACRFIRS6",452,0)
 S ACRNAME=$P(ACRVEN,U)
"RTN","ACRFIRS6",453,0)
 S ACRNAME=$O(^TMP("ACR1099",$J,ACRNAME),-1)
"RTN","ACRFIRS6",454,0)
 ;
"RTN","ACRFIRS6",455,0)
 S ACRCNT=0
"RTN","ACRFIRS6",456,0)
 F  S ACRNAME=$O(^TMP("ACR1099",$J,ACRNAME)) Q:ACRNAME']""  Q:ACRNAME]ACREND  D
"RTN","ACRFIRS6",457,0)
 . S ACRVEN=0
"RTN","ACRFIRS6",458,0)
 . F  S ACRVEN=$O(^TMP("ACR1099",$J,ACRNAME,ACRVEN)) Q:'ACRVEN  D
"RTN","ACRFIRS6",459,0)
 . . Q:$$AMT(ACRVEN,ACRYR)<600
"RTN","ACRFIRS6",460,0)
 . . S ACRCNT=ACRCNT+1
"RTN","ACRFIRS6",461,0)
 . . I ACRCNT>1,ACRCNT#2 W @IOF
"RTN","ACRFIRS6",462,0)
 . . D PRT(ACRVEN,ACRLOC,ACRYR,ACRCNT,.ACRTAMT,.ACRTCNT)
"RTN","ACRFIRS6",463,0)
 ;
"RTN","ACRFIRS6",464,0)
 D TOTALS(.ACRTAMT,.ACRTCNT)
"RTN","ACRFIRS6",465,0)
 ;
"RTN","ACRFIRS6",466,0)
 K ^TMP("ACR1099",$J)
"RTN","ACRFIRS6",467,0)
 Q
"RTN","ACRFIRS6",468,0)
VEND(ACRVEN)       ;
"RTN","ACRFIRS6",469,0)
 ;----- GETS START AND END VENDORS IN RANGE SELECTION
"RTN","ACRFIRS6",470,0)
 ;
"RTN","ACRFIRS6",471,0)
V ;      RETURNS:
"RTN","ACRFIRS6",472,0)
 ;      ACRVEN  = CONTAINS BEGINNING AND ENDING VENDOR NAME RANGE
"RTN","ACRFIRS6",473,0)
 ; 
"RTN","ACRFIRS6",474,0)
 N DIR,X,Y
"RTN","ACRFIRS6",475,0)
 S ACRVEN=""
"RTN","ACRFIRS6",476,0)
 S DIR(0)="F"
"RTN","ACRFIRS6",477,0)
 S DIR("A")="Start with VENDOR"
"RTN","ACRFIRS6",478,0)
 S DIR("?")="Enter BEGINNING VENDOR in range"
"RTN","ACRFIRS6",479,0)
 D ^DIR
"RTN","ACRFIRS6",480,0)
 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT)) S ACRVEN="" Q
"RTN","ACRFIRS6",481,0)
 Q:Y']""
"RTN","ACRFIRS6",482,0)
 S ACRVEN=Y
"RTN","ACRFIRS6",483,0)
 S DIR("A")="End with VENDOR"
"RTN","ACRFIRS6",484,0)
 S DIR("?")="Enter ENDING VENDOR in range"
"RTN","ACRFIRS6",485,0)
 D ^DIR
"RTN","ACRFIRS6",486,0)
 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT)) S ACRVEN="" Q
"RTN","ACRFIRS6",487,0)
 I Y']"" S ACRVEN="" Q
"RTN","ACRFIRS6",488,0)
 I Y']ACRVEN D  G V
"RTN","ACRFIRS6",489,0)
 . W !,"'",Y,"' does not follow '",ACRVEN,"'"
"RTN","ACRFIRS6",490,0)
 S ACRVEN=ACRVEN_"^"_Y
"RTN","ACRFIRS6",491,0)
 Q
"RTN","ACRFIRS6",492,0)
TOTALS(ACRTAMT,ACRTCNT)      ;
"RTN","ACRFIRS6",493,0)
 ;----- PRINTS GRAND TOTALS
"RTN","ACRFIRS6",494,0)
 ;
"RTN","ACRFIRS6",495,0)
 ;      INPUT:
"RTN","ACRFIRS6",496,0)
 ;      ACRTAMT = ARRAY CONTAINING AMOUNT TOTALS BY PAYMENT TYPE CODE
"RTN","ACRFIRS6",497,0)
 ;      ACRTCNT = ARRAY CONTAINING VENDOR COUNTS BY PAYMENT TYPE CODE
"RTN","ACRFIRS6",498,0)
 ;
"RTN","ACRFIRS6",499,0)
 W @IOF
"RTN","ACRFIRS6",500,0)
 ;
"RTN","ACRFIRS6",501,0)
 N ACRGAMT,ACRGCNT,ACRTYP,I
"RTN","ACRFIRS6",502,0)
 ;
"RTN","ACRFIRS6",503,0)
 S ACRTYP(1)="RENTS"
"RTN","ACRFIRS6",504,0)
 S ACRTYP(2)="ROYALTIES"
"RTN","ACRFIRS6",505,0)
 S ACRTYP(3)="OTHER INCOME"
"RTN","ACRFIRS6",506,0)
 S ACRTYP(4)="FED INC TAX WHLD"
"RTN","ACRFIRS6",507,0)
 S ACRTYP(5)="FISHING BOAT PROC"
"RTN","ACRFIRS6",508,0)
 S ACRTYP(6)="MED & HLTH CARE"
"RTN","ACRFIRS6",509,0)
 S ACRTYP(7)="NONEMPLOYEE COMP"
"RTN","ACRFIRS6",510,0)
 S ACRTYP(8)="SUBSTITUTE PMTS"
"RTN","ACRFIRS6",511,0)
 S ACRTYP("A")="CROP INS PROC"
"RTN","ACRFIRS6",512,0)
 S ACRTYP("B")="EXC GOLD PARA"
"RTN","ACRFIRS6",513,0)
 S ACRTYP("C")="PROC TO ATTY"
"RTN","ACRFIRS6",514,0)
 ;
"RTN","ACRFIRS6",515,0)
 F I=1:1:3 W !
"RTN","ACRFIRS6",516,0)
 ;
"RTN","ACRFIRS6",517,0)
 S (ACRGCNT,ACRGAMT)=0
"RTN","ACRFIRS6",518,0)
 F I=1:1:8,"A","B","C" D
"RTN","ACRFIRS6",519,0)
 . ;Q:'$D(ACRTAMT(I))
"RTN","ACRFIRS6",520,0)
 . W ?5,"TOTAL FOR ",ACRTYP(I)," PMTS:"
"RTN","ACRFIRS6",521,0)
 . W ?40,$J(+$G(ACRTCNT(I)),4)
"RTN","ACRFIRS6",522,0)
 . W ?50,$J(+$G(ACRTAMT(I)),12,2)
"RTN","ACRFIRS6",523,0)
 . S ACRGCNT=$G(ACRGCNT)+$G(ACRTCNT(I))
"RTN","ACRFIRS6",524,0)
 . S ACRGAMT=$G(ACRGAMT)+$G(ACRTAMT(I))
"RTN","ACRFIRS6",525,0)
 . W !!
"RTN","ACRFIRS6",526,0)
 ;
"RTN","ACRFIRS6",527,0)
 W ?40,"----"
"RTN","ACRFIRS6",528,0)
 W ?50,"------------"
"RTN","ACRFIRS6",529,0)
 W !
"RTN","ACRFIRS6",530,0)
 W ?40,$J(ACRGCNT,4)
"RTN","ACRFIRS6",531,0)
 W ?50,$J(ACRGAMT,12,2)
"RTN","ACRFIRS6",532,0)
 Q
"RTN","ACRFIRS6",533,0)
AMT(ACRVEN,ACRYR)  ;
"RTN","ACRFIRS6",534,0)
 ;----- EXTRINSIC FUNCTION TO RETURN DOLLAR AMOUNT
"RTN","ACRFIRS6",535,0)
 ;
"RTN","ACRFIRS6",536,0)
 N X
"RTN","ACRFIRS6",537,0)
 S X=$G(^ACR1099V(ACRVEN,1,ACRYR,0))
"RTN","ACRFIRS6",538,0)
 S Y=$P(X,U,2)
"RTN","ACRFIRS6",539,0)
 I $P(X,U,6)="Y" S Y=$P(X,U,8)
"RTN","ACRFIRS6",540,0)
 Q Y
"RTN","ACRFIRS6",541,0)
PADD(ACRLOC,ACRPADD)         ;
"RTN","ACRFIRS6",542,0)
 ;----- RETURN PAYER'S ADDRESS ARRAY
"RTN","ACRFIRS6",543,0)
 ;
"RTN","ACRFIRS6",544,0)
 N I,DATA,X
"RTN","ACRFIRS6",545,0)
 K ACRPADD
"RTN","ACRFIRS6",546,0)
 F I=1:1:4 S ACRPADD(I)=""
"RTN","ACRFIRS6",547,0)
 S I=0
"RTN","ACRFIRS6",548,0)
 S DATA=$G(^ACR1099P(ACRLOC,0))
"RTN","ACRFIRS6",549,0)
 I $P(DATA,U,2)]"" D
"RTN","ACRFIRS6",550,0)
 . S I=I+1
"RTN","ACRFIRS6",551,0)
 . S ACRPADD(I)=$P(DATA,U,2)
"RTN","ACRFIRS6",552,0)
 I $P(DATA,U,3)]"" D
"RTN","ACRFIRS6",553,0)
 . S I=I+1
"RTN","ACRFIRS6",554,0)
 . S ACRPADD(I)=$P(DATA,U,3)
"RTN","ACRFIRS6",555,0)
 I $P(DATA,U,4)]"" D
"RTN","ACRFIRS6",556,0)
 . S I=I+1
"RTN","ACRFIRS6",557,0)
 . S ACRPADD(I)=$P(DATA,U,4)
"RTN","ACRFIRS6",558,0)
 S X=$P(DATA,U,5)_", "_$P(^DIC(5,$P(DATA,U,6),0),U,2)_"  "_$P(DATA,U,7)
"RTN","ACRFIRS6",559,0)
 S I=I+1
"RTN","ACRFIRS6",560,0)
 S ACRPADD(I)=X
"RTN","ACRFIRS6",561,0)
 Q
"RTN","ACRFIRS6",562,0)
VADD(ACRVEN,ACRIRS,ACRVADD)  ;
"RTN","ACRFIRS6",563,0)
 ;----- RETURN VENDOR'S ADDRESS ARRAY
"RTN","ACRFIRS6",564,0)
 ;
"RTN","ACRFIRS6",565,0)
 N I,DATA,X
"RTN","ACRFIRS6",566,0)
 K ACRVADD
"RTN","ACRFIRS6",567,0)
 F I=1:1:4 S ACRVADD(I)=""
"RTN","ACRFIRS6",568,0)
 S ACRVADD(1)=$P(^AUTTVNDR(ACRVEN,0),U)
"RTN","ACRFIRS6",569,0)
 I ACRIRS]"" S ACRVADD(1)=ACRIRS
"RTN","ACRFIRS6",570,0)
 S I=1
"RTN","ACRFIRS6",571,0)
 S DATA=$G(^AUTTVNDR(ACRVEN,13))
"RTN","ACRFIRS6",572,0)
 I $P(DATA,U)]"" D
"RTN","ACRFIRS6",573,0)
 . S I=I+1
"RTN","ACRFIRS6",574,0)
 . S ACRVADD(I)=$P(DATA,U)
"RTN","ACRFIRS6",575,0)
 I $P(DATA,U,10)]"" D
"RTN","ACRFIRS6",576,0)
 . S I=I+1
"RTN","ACRFIRS6",577,0)
 . S ACRVADD(I)=$P(DATA,U,10)
"RTN","ACRFIRS6",578,0)
 S X=$P(DATA,U,2)_", "_$P(^DIC(5,$P(DATA,U,3),0),U,2)_"  "_$P(DATA,U,4)
"RTN","ACRFIRS6",579,0)
 S ACRVADD(4)=X
"RTN","ACRFIRS6",580,0)
 Q
"VER")
8.0^21.0
**END**
**END**