ACRFIRS5.m

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