ACRFIRS4 ;IHS/OIRM/DSD/AEF - CALCULATE YTD PAYMENTS TO VENDORS [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGMT SYSTEM;;NOV 05, 2001
;
;This routine loops through the payments in the 1166 Approvals for
;Payment file for the export date range specified and totals up all the
;payment amounts and places the total amount in the YTD PAID field
;of the Vendor file.
;
EN ;----- MAIN ENTRY POINT
;
N Z
D ^XBKVAR
D HOME^%ZIS
D DATES
Q:'+Z
D ZERO
D LOOP(Z)
Q
LOOP(Z) ;----- LOOP THROUGH PAYMENTS AND SET TOTALS
;
; Z = BEGINNING DATE^ENDING DATE
;
N AMOUNT,DATA,DATE,DIR,END,FY,SEQ,VENDOR
S DATE=$P(Z,U)-1
S END=$P(Z,U,2)
F S DATE=$O(^AFSLAFP("EXP",DATE)) Q:'DATE Q:DATE>END D
. S FY=0
. F S FY=$O(^AFSLAFP("EXP",DATE,FY)) Q:'FY D
. . S BCH=0
. . F S BCH=$O(^AFSLAFP("EXP",DATE,FY,BCH)) Q:'BCH D
. . . S SEQ=0
. . . F S SEQ=$O(^AFSLAFP(FY,1,BCH,1,SEQ)) Q:'SEQ D
. . . . S DATA=$G(^AFSLAFP(FY,1,BCH,1,SEQ,0))
. . . . S VENDOR=$P(DATA,U,10)
. . . . Q:'VENDOR
. . . . S AMOUNT=$P(DATA,U,11)
. . . . D SET(VENDOR,AMOUNT)
W !,"DONE"
S DIR(0)="E"
D ^DIR
Q
SET(VENDOR,AMOUNT) ;
;----- SET DATA INTO 1166 AFP 1099-VENDORS FILE
;
N YTD,DA,DIE,DR
S YTD=$P(^AUTTVNDR(VENDOR,11),U,7)
S YTD=YTD+AMOUNT
S DA=VENDOR
S DIE="^AUTTVNDR("
S DR="1107///^S X=YTD"
D ^DIE
Q
DATES ;----- ASK FOR BEGINNING AND ENDING DATES
;
; Returns Z = BEGIN^END
;
N DIR,X,Y
W !
S Z=""
S DIR(0)="DO^::E"
S DIR("A")="Enter BEGINNING DATE"
D ^DIR
Q:Y'>0
S Z=Y
S DIR("A")="Enter ENDING DATE"
D ^DIR
Q:Y'>0
I Y<Z W !,*7,"ENDING DATE cannot be less than BEGINNING DATE!" G DATES
S $P(Z,U,2)=Y
Q
ENZ ;EP -- ENTRY POINT TO SET VENDOR YTD FIELDS TO NULL
;
S DIR(0)="Y"
S DIR("A")="Do you want to ZERO out the Year-To-Date field for all Vendors"
S DIR("B")="NO"
D ^DIR
I Y D ZERO W !," DONE!"
Q
ZERO ;----- SET YTD FIELDS TO NULL
;
N DA,DIE,DR,VENDOR,X,Y
S VENDOR=0
F S VENDOR=$O(^AUTTVNDR(VENDOR)) Q:'VENDOR D
. S DA=VENDOR
. S DIE="^AUTTVNDR("
. S DR="1107///^S X=""@"""
. D ^DIE
Q
ACRFIRS4 ;IHS/OIRM/DSD/AEF - CALCULATE YTD PAYMENTS TO VENDORS [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGMT SYSTEM;;NOV 05, 2001
+2 ;
+3 ;This routine loops through the payments in the 1166 Approvals for
+4 ;Payment file for the export date range specified and totals up all the
+5 ;payment amounts and places the total amount in the YTD PAID field
+6 ;of the Vendor file.
+7 ;
EN ;----- MAIN ENTRY POINT
+1 ;
+2 NEW Z
+3 DO ^XBKVAR
+4 DO HOME^%ZIS
+5 DO DATES
+6 IF '+Z
QUIT
+7 DO ZERO
+8 DO LOOP(Z)
+9 QUIT
LOOP(Z) ;----- LOOP THROUGH PAYMENTS AND SET TOTALS
+1 ;
+2 ; Z = BEGINNING DATE^ENDING DATE
+3 ;
+4 NEW AMOUNT,DATA,DATE,DIR,END,FY,SEQ,VENDOR
+5 SET DATE=$PIECE(Z,U)-1
+6 SET END=$PIECE(Z,U,2)
+7 FOR
SET DATE=$ORDER(^AFSLAFP("EXP",DATE))
IF 'DATE
QUIT
IF DATE>END
QUIT
Begin DoDot:1
+8 SET FY=0
+9 FOR
SET FY=$ORDER(^AFSLAFP("EXP",DATE,FY))
IF 'FY
QUIT
Begin DoDot:2
+10 SET BCH=0
+11 FOR
SET BCH=$ORDER(^AFSLAFP("EXP",DATE,FY,BCH))
IF 'BCH
QUIT
Begin DoDot:3
+12 SET SEQ=0
+13 FOR
SET SEQ=$ORDER(^AFSLAFP(FY,1,BCH,1,SEQ))
IF 'SEQ
QUIT
Begin DoDot:4
+14 SET DATA=$GET(^AFSLAFP(FY,1,BCH,1,SEQ,0))
+15 SET VENDOR=$PIECE(DATA,U,10)
+16 IF 'VENDOR
QUIT
+17 SET AMOUNT=$PIECE(DATA,U,11)
+18 DO SET(VENDOR,AMOUNT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 WRITE !,"DONE"
+20 SET DIR(0)="E"
+21 DO ^DIR
+22 QUIT
SET(VENDOR,AMOUNT) ;
+1 ;----- SET DATA INTO 1166 AFP 1099-VENDORS FILE
+2 ;
+3 NEW YTD,DA,DIE,DR
+4 SET YTD=$PIECE(^AUTTVNDR(VENDOR,11),U,7)
+5 SET YTD=YTD+AMOUNT
+6 SET DA=VENDOR
+7 SET DIE="^AUTTVNDR("
+8 SET DR="1107///^S X=YTD"
+9 DO ^DIE
+10 QUIT
DATES ;----- ASK FOR BEGINNING AND ENDING DATES
+1 ;
+2 ; Returns Z = BEGIN^END
+3 ;
+4 NEW DIR,X,Y
+5 WRITE !
+6 SET Z=""
+7 SET DIR(0)="DO^::E"
+8 SET DIR("A")="Enter BEGINNING DATE"
+9 DO ^DIR
+10 IF Y'>0
QUIT
+11 SET Z=Y
+12 SET DIR("A")="Enter ENDING DATE"
+13 DO ^DIR
+14 IF Y'>0
QUIT
+15 IF Y<Z
WRITE !,*7,"ENDING DATE cannot be less than BEGINNING DATE!"
GOTO DATES
+16 SET $PIECE(Z,U,2)=Y
+17 QUIT
ENZ ;EP -- ENTRY POINT TO SET VENDOR YTD FIELDS TO NULL
+1 ;
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Do you want to ZERO out the Year-To-Date field for all Vendors"
+4 SET DIR("B")="NO"
+5 DO ^DIR
+6 IF Y
DO ZERO
WRITE !," DONE!"
+7 QUIT
ZERO ;----- SET YTD FIELDS TO NULL
+1 ;
+2 NEW DA,DIE,DR,VENDOR,X,Y
+3 SET VENDOR=0
+4 FOR
SET VENDOR=$ORDER(^AUTTVNDR(VENDOR))
IF 'VENDOR
QUIT
Begin DoDot:1
+5 SET DA=VENDOR
+6 SET DIE="^AUTTVNDR("
+7 SET DR="1107///^S X=""@"""
+8 DO ^DIE
End DoDot:1
+9 QUIT
