- 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
