ACRFCAL1.m

ACRFCAL1 ;IHS/OIRM/DSD/THL,AEF - RECALCULATE FMS DISTRIBUTION FIL;  [ 11/01/2001   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 ;;ROUTINE USED TO RECALCULATE ALL FINANCIAL TRANSACTIONS

EN D SUPP

 D REQ

 Q

SUPP ;CHECKS THROUGH ALL SERVICES/SUPPLIES IN THE 'ACRSS(' GLOBAL TO ENSURE

 ;EACH IS A COMPLETE RECORD

 Q

 I $E($G(IOST),1,2)="C-" W !!,"Data integrity check.  Please wait."

 S ACRDA=0

 F  S ACRDA=$O(^ACRSS(ACRDA)) Q:'ACRDA  D

 .S (ACRSSDA,DA)=ACRDA

 .D SSCHK^ACRFSSA Q

 .I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q

 .F ACRI=13,18,16 D

 ..S DA=ACRSSDA

 ..S DIK(1)=ACRI_U_1

 ..S DIK="^ACRSS("

 ..D EN1^DIK

 Q

REQ ;CHECKS ALL ITEMS REQUESTED ON EACH REQUEST AND RESETS THE AMOUNT

 ;REQUESTED, OBLIGATED AND SPENT FOR THE REQUEST

 I $E($G(IOST),1,2)="C-" D

 .W !!,"Recalculating all requested items.  Please wait."

 S ACRDA=0

 F  S ACRDA=$O(^ACROBL(ACRDA)) Q:'ACRDA  D

 .S DA=ACRDA

 .L +^ACROBL(DA):4 Q:'$T

 .S $P(^ACROBL(DA,0),U)=0

 .S $P(^ACROBL(DA,"DT"),U,4)=0

 .S $P(^ACROBL(DA,"DT"),U,2)=0

 .S (ACRREQ,ACROBL,ACRSPT,ACRX)=0

 .F  S ACRX=$O(^ACRSS("J",DA,ACRX)) Q:'ACRX  D

 ..S ACRREQ=ACRREQ+$P($G(^ACRSS(ACRX,"DT")),U,4)

 ..S ACROBL=ACROBL+$P($G(^ACRSS(ACRX,"DT")),U,9)

 ..S ACRSPT=ACRSPT+$P($G(^ACRSS(ACRX,"DT")),U,21)

 .S $P(^ACROBL(DA,0),U)=ACRREQ

 .S $P(^ACROBL(DA,"DT"),U,4)=ACROBL

 .S $P(^ACROBL(DA,"DT"),U,2)=ACRSPT

 .L -^ACROBL(DA):0

 Q

ACRFCAL1  ;IHS/OIRM/DSD/THL,AEF - RECALCULATE FMS DISTRIBUTION FIL;  [ 11/01/2001   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 +2       ;;ROUTINE USED TO RECALCULATE ALL FINANCIAL TRANSACTIONS

EN         DO SUPP

 +1        DO REQ

 +2        QUIT 

SUPP      ;CHECKS THROUGH ALL SERVICES/SUPPLIES IN THE 'ACRSS(' GLOBAL TO ENSURE

 +1       ;EACH IS A COMPLETE RECORD

 +2        QUIT 

 +3        IF $EXTRACT($GET(IOST),1,2)="C-"

               WRITE !!,"Data integrity check.  Please wait."

 +4        SET ACRDA=0

 +5        FOR 

               SET ACRDA=$ORDER(^ACRSS(ACRDA))

               IF 'ACRDA

                   QUIT 

               Begin DoDot:1

 +6                SET (ACRSSDA,DA)=ACRDA

 +7                DO SSCHK^ACRFSSA

                   QUIT 

 +8                IF $DATA(ACRQUIT)!$DATA(ACROUT)

                       KILL ACRQUIT

                       QUIT 

 +9                FOR ACRI=13,18,16

                       Begin DoDot:2

 +10                       SET DA=ACRSSDA

 +11                       SET DIK(1)=ACRI_U_1

 +12                       SET DIK="^ACRSS("

 +13                       DO EN1^DIK

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

REQ       ;CHECKS ALL ITEMS REQUESTED ON EACH REQUEST AND RESETS THE AMOUNT

 +1       ;REQUESTED, OBLIGATED AND SPENT FOR THE REQUEST

 +2        IF $EXTRACT($GET(IOST),1,2)="C-"

               Begin DoDot:1

 +3                WRITE !!,"Recalculating all requested items.  Please wait."

               End DoDot:1

 +4        SET ACRDA=0

 +5        FOR 

               SET ACRDA=$ORDER(^ACROBL(ACRDA))

               IF 'ACRDA

                   QUIT 

               Begin DoDot:1

 +6                SET DA=ACRDA

 +7                LOCK +^ACROBL(DA):4

                   IF '$TEST

                       QUIT 

 +8                SET $PIECE(^ACROBL(DA,0),U)=0

 +9                SET $PIECE(^ACROBL(DA,"DT"),U,4)=0

 +10               SET $PIECE(^ACROBL(DA,"DT"),U,2)=0

 +11               SET (ACRREQ,ACROBL,ACRSPT,ACRX)=0

 +12               FOR 

                       SET ACRX=$ORDER(^ACRSS("J",DA,ACRX))

                       IF 'ACRX

                           QUIT 

                       Begin DoDot:2

 +13                       SET ACRREQ=ACRREQ+$PIECE($GET(^ACRSS(ACRX,"DT")),U,4)

 +14                       SET ACROBL=ACROBL+$PIECE($GET(^ACRSS(ACRX,"DT")),U,9)

 +15                       SET ACRSPT=ACRSPT+$PIECE($GET(^ACRSS(ACRX,"DT")),U,21)

                       End DoDot:2

 +16               SET $PIECE(^ACROBL(DA,0),U)=ACRREQ

 +17               SET $PIECE(^ACROBL(DA,"DT"),U,4)=ACROBL

 +18               SET $PIECE(^ACROBL(DA,"DT"),U,2)=ACRSPT

 +19               LOCK -^ACROBL(DA):0

               End DoDot:1

 +20       QUIT