ACRFIRS5 ;IHS/OIRM/DSD/AEF - TRANSFER VENDOR DATA TO 1099 FILE [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;
;Transfers vendor information for vendors with YTD PAID from
;Vendor file to 1099 Vendor file.
;
EN ;EP -- MAIN ENTRY POINT
;
N ACRCD,ACRISDT,ACRYR
D HOME^%ZIS
D ^XBKVAR
D MSG
D YEAR(.ACRYR)
Q:'$G(ACRYR)
D AMTCD(.ACRCD)
D LOOP(ACRYR,ACRCD)
Q
LOOP(ACRYR,ACRCD) ;
;----- LOOPS THROUGH VENDOR FILE AND PUTS DATA INTO 1099 VENDORS FILE
;
N ACRVEND
S ACRVEND=0
F S ACRVEND=$O(^AUTTVNDR(ACRVEND)) Q:'ACRVEND D
. Q:$P($G(^AUTTVNDR(ACRVEND,11)),U,6)'="Y"
. S ACRYTD=$P($G(^AUTTVNDR(ACRVEND,11)),U,7)
. I ACRYTD>599.99 D SET(ACRVEND,ACRYR,ACRYTD,ACRCD)
Q
SET(ACRVEND,ACRYR,ACRYTD,ACRCD) ;
;----- SETS VENDOR DATA INTO ARMS 1099 VENDORS FILE
;
N DA,DIE,DR,X,Y
I '$D(^ACR1099V(ACRVEND)) D NEWVEND(ACRVEND)
Q:'$D(^ACR1099V(ACRVEND))
I '$D(^ACR1099V(ACRVEND,1,ACRYR)) D NEWYR(ACRVEND,ACRYR)
Q:'$D(^ACR1099V(ACRVEND,1,ACRYR))
S DA=ACRYR
S DA(1)=ACRVEND
S DIE="^ACR1099V("_DA(1)_",1,"
S DR=".02///^S X=ACRYTD"
D ^DIE
K DA,DIE,DR
S DIE="^ACR1099V("
S DA=ACRVEND
S DR=".02////"_ACRCD
D ^DIE
Q
NEWYR(ACRVEND,ACRYR) ;
;----- ADD NEW YEAR MULTIPLE TO ARMS 1099 VENDOR FILE
;
N DA,DD,DIC,DLAYGO,DO,X,Y
S (DINUM,X)=ACRYR
S DA(1)=ACRVEND
S DIC="^ACR1099V("_DA(1)_",1,"
S DIC(0)=""
S DIC("P")=$P(^DD(9002198.2,1,0),U,2)
S DLAYGO=9002198.21
K DD,DO
D FILE^DICN
Q
NEWVEND(ACRVEND) ;
;----- ADD NEW VENDOR TO 1099 VENDOR FILE
;
N DD,DIC,DINUM,DLAYGO,DO,X,Y
S (DINUM,X)=ACRVEND
S DIC="^ACR1099V("
S DIC(0)=""
S DLAYGO=9002198.2
K DD,DO
D FILE^DICN
Q
YEAR(ACRYR) ;
;----- SELECT CALENDAR YEAR FOR 1099s
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="N^0000:9999"
S DIR("A")="Select 1099 CALENDAR YEAR"
S DIR("B")=($E(DT,1,3)+1700)-1
D ^DIR
Q:$D(DIRUT)!($D(DTOUT))!($D(DUOUT))
Q:+Y'>0
S ACRYR=+Y
Q
AMTCD(ACRCD) ;
;----- SELECT PAYMENT TYPE CODE
;
K DIR,X,Y
S ACRCD=""
S DIR(0)="Y"
S DIR("A")="Do you want to set all payment type codes to one code, then change selected entries"
S DIR("B")="Y"
D ^DIR
Q:'Y
A ;----- LOOP
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="F^1:1"
S DIR("A")="Select PAYMENT TYPE CODE (1-9,A,B,C)"
S DIR("B")=7
D ^DIR
Q:$D(DUOUT)!($D(DIRUT))!($D(DTOUT))
I Y="" W " ??" G A
I Y=0 W " ??" G A
I Y?1A I "ABC"'[Y W " ??" G A
S ACRCD=Y
Q
MSG ;----- WRITES MESSAGE
;
W !!,"This option transfers vendor information from the master Vendor file"
W !,"to the ARMS 1099 Vendors file. It will be used to control the exporting"
W !,"to download files. Only vendors with YTD PAID > 599.99 will be"
W !,"transferred."
W !
Q
ACRFIRS5 ;IHS/OIRM/DSD/AEF - TRANSFER VENDOR DATA TO 1099 FILE [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;
+3 ;Transfers vendor information for vendors with YTD PAID from
+4 ;Vendor file to 1099 Vendor file.
+5 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW ACRCD,ACRISDT,ACRYR
+3 DO HOME^%ZIS
+4 DO ^XBKVAR
+5 DO MSG
+6 DO YEAR(.ACRYR)
+7 IF '$GET(ACRYR)
QUIT
+8 DO AMTCD(.ACRCD)
+9 DO LOOP(ACRYR,ACRCD)
+10 QUIT
LOOP(ACRYR,ACRCD) ;
+1 ;----- LOOPS THROUGH VENDOR FILE AND PUTS DATA INTO 1099 VENDORS FILE
+2 ;
+3 NEW ACRVEND
+4 SET ACRVEND=0
+5 FOR
SET ACRVEND=$ORDER(^AUTTVNDR(ACRVEND))
IF 'ACRVEND
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^AUTTVNDR(ACRVEND,11)),U,6)'="Y"
QUIT
+7 SET ACRYTD=$PIECE($GET(^AUTTVNDR(ACRVEND,11)),U,7)
+8 IF ACRYTD>599.99
DO SET(ACRVEND,ACRYR,ACRYTD,ACRCD)
End DoDot:1
+9 QUIT
SET(ACRVEND,ACRYR,ACRYTD,ACRCD) ;
+1 ;----- SETS VENDOR DATA INTO ARMS 1099 VENDORS FILE
+2 ;
+3 NEW DA,DIE,DR,X,Y
+4 IF '$DATA(^ACR1099V(ACRVEND))
DO NEWVEND(ACRVEND)
+5 IF '$DATA(^ACR1099V(ACRVEND))
QUIT
+6 IF '$DATA(^ACR1099V(ACRVEND,1,ACRYR))
DO NEWYR(ACRVEND,ACRYR)
+7 IF '$DATA(^ACR1099V(ACRVEND,1,ACRYR))
QUIT
+8 SET DA=ACRYR
+9 SET DA(1)=ACRVEND
+10 SET DIE="^ACR1099V("_DA(1)_",1,"
+11 SET DR=".02///^S X=ACRYTD"
+12 DO ^DIE
+13 KILL DA,DIE,DR
+14 SET DIE="^ACR1099V("
+15 SET DA=ACRVEND
+16 SET DR=".02////"_ACRCD
+17 DO ^DIE
+18 QUIT
NEWYR(ACRVEND,ACRYR) ;
+1 ;----- ADD NEW YEAR MULTIPLE TO ARMS 1099 VENDOR FILE
+2 ;
+3 NEW DA,DD,DIC,DLAYGO,DO,X,Y
+4 SET (DINUM,X)=ACRYR
+5 SET DA(1)=ACRVEND
+6 SET DIC="^ACR1099V("_DA(1)_",1,"
+7 SET DIC(0)=""
+8 SET DIC("P")=$PIECE(^DD(9002198.2,1,0),U,2)
+9 SET DLAYGO=9002198.21
+10 KILL DD,DO
+11 DO FILE^DICN
+12 QUIT
NEWVEND(ACRVEND) ;
+1 ;----- ADD NEW VENDOR TO 1099 VENDOR FILE
+2 ;
+3 NEW DD,DIC,DINUM,DLAYGO,DO,X,Y
+4 SET (DINUM,X)=ACRVEND
+5 SET DIC="^ACR1099V("
+6 SET DIC(0)=""
+7 SET DLAYGO=9002198.2
+8 KILL DD,DO
+9 DO FILE^DICN
+10 QUIT
YEAR(ACRYR) ;
+1 ;----- SELECT CALENDAR YEAR FOR 1099s
+2 ;
+3 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+4 SET DIR(0)="N^0000:9999"
+5 SET DIR("A")="Select 1099 CALENDAR YEAR"
+6 SET DIR("B")=($EXTRACT(DT,1,3)+1700)-1
+7 DO ^DIR
+8 IF $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+9 IF +Y'>0
QUIT
+10 SET ACRYR=+Y
+11 QUIT
AMTCD(ACRCD) ;
+1 ;----- SELECT PAYMENT TYPE CODE
+2 ;
+3 KILL DIR,X,Y
+4 SET ACRCD=""
+5 SET DIR(0)="Y"
+6 SET DIR("A")="Do you want to set all payment type codes to one code, then change selected entries"
+7 SET DIR("B")="Y"
+8 DO ^DIR
+9 IF 'Y
QUIT
A ;----- LOOP
+1 ;
+2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="F^1:1"
+4 SET DIR("A")="Select PAYMENT TYPE CODE (1-9,A,B,C)"
+5 SET DIR("B")=7
+6 DO ^DIR
+7 IF $DATA(DUOUT)!($DATA(DIRUT))!($DATA(DTOUT))
QUIT
+8 IF Y=""
WRITE " ??"
GOTO A
+9 IF Y=0
WRITE " ??"
GOTO A
+10 IF Y?1A
IF "ABC"'[Y
WRITE " ??"
GOTO A
+11 SET ACRCD=Y
+12 QUIT
MSG ;----- WRITES MESSAGE
+1 ;
+2 WRITE !!,"This option transfers vendor information from the master Vendor file"
+3 WRITE !,"to the ARMS 1099 Vendors file. It will be used to control the exporting"
+4 WRITE !,"to download files. Only vendors with YTD PAID > 599.99 will be"
+5 WRITE !,"transferred."
+6 WRITE !
+7 QUIT
