ACRFEA43 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA - CONT; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ACRFEA4 CON'T
EN ;EP;
I ACRREF=148 D REMARKS Q
D CALLERS
I '$D(ACROUT),$E($P($G(ACRDOC0),U,2),9,10)'="BP",'$P($G(ACRDOC0),U,19) D
.D FEDSTRIP
.D DRAFT:ACRREF=103!($P(ACRDOC0,U,4)'=35)
D RECEIVER:'$D(ACROUT)
I '$D(ACROUT),$P(ACRDOC0,U,19),$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5)=$P($G(^ACRSYS(1,"DT1")),U,12) D PVENDOR:'$D(ACROUT)
Q
FEDSTRIP ;EP;EDIT FEDSRIP DATA
I ACRREF=116!(ACRREF=103)!(ACRREF=210),$P(ACRDOC0,U,4)'=35,'$P(ACRDOC0,U,12) D FS
I $P(^ACRDOC(ACRDOCDA,0),U,4)=35 D
.I '$D(ACRNEWOB) D CC I 1
.E D CC1
K ACRQUIT
Q
FS S DIR(0)="YO"
S DIR("A")="Is this a FEDSTRIP or GSA SUPPLY CENTER order"
S DIR("B")="NO"
I $D(^ACRDOC(ACRDOCDA,3)),$P(^(3),U,11)]""!($P(^(3),U,12)]"") S DIR("B")="YES"
W !
D DIR^ACRFDIC
N ACRREF,ACRREFDA
FEDSET ;EP;
I Y=0,$D(^ACRDOC(ACRDOCDA,3)) N ACR3 S ACR3=^(3) D Q
.N X
.K ACRQUIT
.F X=11:1:17 I $P(ACR3,U,X)]"" S ACRQUIT="" Q
.Q:'$D(ACRQUIT)
.K ACRQUIT
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="14///@;15///@;16///@;17///@;18///@;.13///"_$S($E($G(^ACROBL(ACRDOCDA,"APV")))="A":103,1:116)
.D DIE^ACRFDIC
.S $P(^ACRDOC(ACRDOCDA,3),U,17)=""
I Y=1 D
.K ACRQUIT
.N X,ACR3
.S ACR3=$G(^ACRDOC(ACRDOCDA,3))
.F X=11:1:15 I $P(ACR3,U,X)="" S ACRQUIT="" Q
.I $D(ACRQUIT)#2 D FEDSET^ACRFEA4 K ACRQUIT
.Q:$D(DDSFILE)
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="[ACR FEDSTRIP ORDER]"
.D DDS^ACRFDIC
.Q:'$D(ACRSCREN)
.K ACRSCREN
.W !
.D DIE^ACRFDIC
Q
CC ;EP;TO INDICATE IF CREDIT CARD PURCHASE
S DIR(0)="YO"
S DIR("A")="Is this a Credit Card purchase"
S DIR("B")="NO"
I $P(^ACRDOC(ACRDOCDA,0),U,4)=35 D
.S DIR("A")="Keep this as a CREDIT CARD purchase",DIR("B")="YES"
W !
D DIR^ACRFDIC
I +Y'=1 D Q
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR=$S($P(^ACRDOC(ACRDOCDA,0),U,4)=35&($P(^(0),U,7)'=35):".04////"_$P(^(0),U,7),1:".04T")_";.25///@"
.W !
.D DIE^ACRFDIC
.I $E(^ACROBL(ACRDOCDA,"APV"))="A",$P(^ACRDOC(ACRDOCDA,0),U,13)=33 D
..S DA=ACRDOCDA
..S DIE="^ACRDOC("
..S DR=".13///103"
..D DIE^ACRFDIC
..S DA=ACRDOCDA
..S DIE="^ACROBL("
..S DR=".1///103;905///A;906///Y"
..D DIE^ACRFDIC
CC1 ;EP;
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR=".04////35;.25T;113110DATE PURCHASED......"
I $P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,8)="" S DR=DR_";113370////"_DUZ
I $P($G(^ACRDOC(ACRDOCDA,0)),U,14)="" S DR=DR_";.14////CREDIT CARD PUR"
W !
D DIE^ACRFDIC
I $P(^ACRDOC(ACRDOCDA,0),U,25)="" D G CC1
.W !!,"You must enter the name of the CREDIT CARD HOLDER for this purchase."
Q
RECEIVER ;EP;EDIT RECEIVING OFFICIAL FOR REQ FOR SERVICE AND CALL IF CALL
Q:$P($G(^ACRDOC(+$G(ACRDOCDA),0)),U,4)=35
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="113200T"_$S($P(^ACRDOC(ACRDOCDA,0),U,19):";24T",1:"")
W !
D DIE^ACRFDIC
CIS ;ENTER SMALL PURCHASE DATA
I ACRREF=103!(ACRREF=349)!(ACRREF=326),$D(ACRPO),'$P(^ACRDOC(ACRDOCDA,0),U,16),$D(^("PO")),$P(^("PO"),U,5),$D(^AUTTVNDR($P(^("PO"),U,5),0)) D ADD^ACRFCIS
Q
CALLERS ;EP;TO EDIT BPA CALLERS
I $D(ACRPO) S ACRDOC0=^ACRDOC(ACRDOCDA,0) D
.I $P(ACRDOC0,U,18)>0!$P(ACRDOC0,U,15) D
..I $P(ACRDOC0,U,15) Q:'$D(^ACRDOC($P(ACRDOC0,U,15),0)) Q:$P(^(0),U,18)'>0 S DA=$P(ACRDOC0,U,15)
..E S DA=ACRDOCDA
..S DIE="^ACRDOC("
..S DR="[ACR BPA CALL LIMIT]"
..D DDS^ACRFDIC
..Q:'$D(ACRSCREN)
..K ACRSCREN
..W !
..D DIE^ACRFDIC
Q
W !
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="[ACR TRAINING OTHER DATA]"
D DDS^ACRFDIC
Q:'$D(ACRSCREN)
K ACRSCREN
D DIE^ACRFDIC
Q
DRAFT ;EP;TO DETERMINE IF DRAFT PAYMENT IS ALLOWED
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR=".12Is DRAFT PAYMENT authorized"
W !
D DIE^ACRFDIC
Q
PVENDOR ;EP;TO ENTER PRIME VENDOR CONTRACT NUMBER FOR THE DOCUMENT
Q:$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5)'=$P($G(^ACRSYS(1,"DT1")),U,12)
I $P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,13)]"" D Q
.N ACR1
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="113420T"
.D DIE^ACRFDIC
.S ACR1=$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,13)
.Q:ACR1=""
.D DOC^ACRFPVEN
D POS^ACRFPVEN
Q
PRINT ;EP;TO PRINT ACCOUNT AUDIT
F D P1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
P1 ;
W @IOF
W !?10,"Select Account for AUDIT REPORT"
S DIR(0)="SO^1:Appropriation;2:Allowance;3:Sub-Allowance;4:Department Account"
S DIR("A")="Which type of account"
W !
D DIR^ACRFDIC
I 'Y S ACRQUIT="" Q
I Y=1 S ACRGLB="^ACRAPP"
I Y=2 S ACRGLB="^ACRALW"
I Y=3 S ACRGLB="^ACRALC"
I Y=4 S ACRGLB="^ACRLOCB"
S DIC=ACRGLB_"("
S DIC(0)="AEMQZ"
S DIC("A")="Which "_$S(Y=1:"APPROPRIATION",Y=2:"ALLOWANCE",Y=3:"SUB-ALLOWANCE",1:"DEPARTMENT ACCOUNT")_": "
S DIC("S")="I $P(^(0),U,8)=""O"",$D(@ACRGLB@(""ORIG"",+Y))"
W !
D DIC^ACRFDIC
Q:+Y<1
S ACRZDA=+Y
ZIS S ZTDESC="ACCOUNT AUDIT REPORT"
S (ZTRTN,ACRRTN)="P2^ACRFEA43"
D ^ACRFZIS
Q
P2 ;EP;TO PRINT ACCOUNT AUDIT REPORT
N ACRTOT,ACRAMT,ACRCMT
D PHEAD
S ACRX=@ACRGLB@(ACRZDA,0),ACRDT=$G(@ACRGLB@(ACRZDA,"DT")),ACRCMT=$G(@ACRGLB@(ACRZDA,"PURP"))
W !,ACRZDA,?7,$P(ACRX,U,8),?9,$E($S(ACRGLB'["ACRLOCB":$P(ACRX,U,12),1:$P($G(^AUTTPRG(+$P(ACRX,U,5),0)),U)),1,25),?35,$P(ACRDT,U,3),?37,$E($P(ACRCMT,U),1,30),?68,$J($FN(+ACRX+$S(ACRGLB["ACRLOCB":$P(ACRX,U,11),1:0),"P",2),12)
S ACRTOT=+ACRX+$S(ACRGLB["ACRLOCB":$P(ACRX,U,11),1:0)
S ACRDA=0
F S ACRDA=$O(@ACRGLB@("ORIG",ACRZDA,ACRDA)) Q:'ACRDA!$D(ACRQUIT) D
.S ACRX=@ACRGLB@(ACRDA,0),ACRDT=$G(@ACRGLB@(ACRDA,"DT")),ACRCMT=$G(@ACRGLB@(ACRDA,"PURP"))
.W !,ACRDA,?7,$P(ACRX,U,8),?9,$E($S(ACRGLB'["ACRLOCB":$P(ACRX,U,12),1:$P($G(^AUTTPRG(+$P(ACRX,U,5),0)),U)),1,25),?35,$P(ACRDT,U,3),?37,$E($P(ACRCMT,U),1,30),?68,$J($FN(+ACRX+$S(ACRGLB["ACRLOCB":$P(ACRX,U,11),1:0),"P",2),12)
.S ACRAMT=$S($P(ACRX,U,8)'="D":1,1:-1)
.S ACRTOT=ACRTOT+(+ACRX*ACRAMT)+$S(ACRGLB["ACRLOCB":$P(ACRX,U,11),1:0)
.I IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACRQUIT) D PHEAD
D PTAIL
K ACRQUIT
D PAUSE^ACRFWARN
Q
PHEAD ;
W @IOF
W !,"Audit of ",$S(ACRGLB["ACRAPP":"APPROPRIATION",ACRGLB["ACRALW":"ALLOWANCE",ACRGLB["ACRALC":"SUB-ALLOWANCE",1:"DEPARTMENT ACCOUNT")," Increases and Decreases."
W !!,"REPORT DATE: "
S Y=DT
X ^DD("DD")
W Y,?35,"R"
W !?35,"E",!,"ID NO.",?9,"ACCOUNT IDENTIFER",?35,"C",?37,"PURPOSE",?68,"AMOUNT"
W !,"------",?7,"-",?9,"-------------------------",?35,"-",?37,"------------------------------",?68,"------------"
Q
PTAIL ;
W !,"------",?7,"-",?9,"-------------------------",?35,"-",?37,"------------------------------",?68,"------------"
W !?30,"TOTAL: ",?68,$J($FN(ACRTOT,"P",2),12)
Q
ACRFEA43 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA - CONT; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ACRFEA4 CON'T
EN ;EP;
+1 IF ACRREF=148
DO REMARKS
QUIT
+2 DO CALLERS
+3 IF '$DATA(ACROUT)
IF $EXTRACT($PIECE($GET(ACRDOC0),U,2),9,10)'="BP"
IF '$PIECE($GET(ACRDOC0),U,19)
Begin DoDot:1
+4 DO FEDSTRIP
+5 IF ACRREF=103!($PIECE(ACRDOC0,U,4)'=35)
DO DRAFT
End DoDot:1
+6 IF '$DATA(ACROUT)
DO RECEIVER
+7 IF '$DATA(ACROUT)
IF $PIECE(ACRDOC0,U,19)
IF $PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5)=$PIECE($GET(^ACRSYS(1,"DT1")),U,12)
IF '$DATA(ACROUT)
DO PVENDOR
+8 QUIT
FEDSTRIP ;EP;EDIT FEDSRIP DATA
+1 IF ACRREF=116!(ACRREF=103)!(ACRREF=210)
IF $PIECE(ACRDOC0,U,4)'=35
IF '$PIECE(ACRDOC0,U,12)
DO FS
+2 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=35
Begin DoDot:1
+3 IF '$DATA(ACRNEWOB)
DO CC
IF 1
+4 IF '$TEST
DO CC1
End DoDot:1
+5 KILL ACRQUIT
+6 QUIT
FS SET DIR(0)="YO"
+1 SET DIR("A")="Is this a FEDSTRIP or GSA SUPPLY CENTER order"
+2 SET DIR("B")="NO"
+3 IF $DATA(^ACRDOC(ACRDOCDA,3))
IF $PIECE(^(3),U,11)]""!($PIECE(^(3),U,12)]"")
SET DIR("B")="YES"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 NEW ACRREF,ACRREFDA
FEDSET ;EP;
+1 IF Y=0
IF $DATA(^ACRDOC(ACRDOCDA,3))
NEW ACR3
SET ACR3=^(3)
Begin DoDot:1
+2 NEW X
+3 KILL ACRQUIT
+4 FOR X=11:1:17
IF $PIECE(ACR3,U,X)]""
SET ACRQUIT=""
QUIT
+5 IF '$DATA(ACRQUIT)
QUIT
+6 KILL ACRQUIT
+7 SET DA=ACRDOCDA
+8 SET DIE="^ACRDOC("
+9 SET DR="14///@;15///@;16///@;17///@;18///@;.13///"_$SELECT($EXTRACT($GET(^ACROBL(ACRDOCDA,"APV")))="A":103,1:116)
+10 DO DIE^ACRFDIC
+11 SET $PIECE(^ACRDOC(ACRDOCDA,3),U,17)=""
End DoDot:1
QUIT
+12 IF Y=1
Begin DoDot:1
+13 KILL ACRQUIT
+14 NEW X,ACR3
+15 SET ACR3=$GET(^ACRDOC(ACRDOCDA,3))
+16 FOR X=11:1:15
IF $PIECE(ACR3,U,X)=""
SET ACRQUIT=""
QUIT
+17 IF $DATA(ACRQUIT)#2
DO FEDSET^ACRFEA4
KILL ACRQUIT
+18 IF $DATA(DDSFILE)
QUIT
+19 SET DA=ACRDOCDA
+20 SET DIE="^ACRDOC("
+21 SET DR="[ACR FEDSTRIP ORDER]"
+22 DO DDS^ACRFDIC
+23 IF '$DATA(ACRSCREN)
QUIT
+24 KILL ACRSCREN
+25 WRITE !
+26 DO DIE^ACRFDIC
End DoDot:1
+27 QUIT
CC ;EP;TO INDICATE IF CREDIT CARD PURCHASE
+1 SET DIR(0)="YO"
+2 SET DIR("A")="Is this a Credit Card purchase"
+3 SET DIR("B")="NO"
+4 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=35
Begin DoDot:1
+5 SET DIR("A")="Keep this as a CREDIT CARD purchase"
SET DIR("B")="YES"
End DoDot:1
+6 WRITE !
+7 DO DIR^ACRFDIC
+8 IF +Y'=1
Begin DoDot:1
+9 SET DA=ACRDOCDA
+10 SET DIE="^ACRDOC("
+11 SET DR=$SELECT($PIECE(^ACRDOC(ACRDOCDA,0),U,4)=35&($PIECE(^(0),U,7)'=35):".04////"_$PIECE(^(0),U,7),1:".04T")_";.25///@"
+12 WRITE !
+13 DO DIE^ACRFDIC
+14 IF $EXTRACT(^ACROBL(ACRDOCDA,"APV"))="A"
IF $PIECE(^ACRDOC(ACRDOCDA,0),U,13)=33
Begin DoDot:2
+15 SET DA=ACRDOCDA
+16 SET DIE="^ACRDOC("
+17 SET DR=".13///103"
+18 DO DIE^ACRFDIC
+19 SET DA=ACRDOCDA
+20 SET DIE="^ACROBL("
+21 SET DR=".1///103;905///A;906///Y"
+22 DO DIE^ACRFDIC
End DoDot:2
End DoDot:1
QUIT
CC1 ;EP;
+1 SET DA=ACRDOCDA
+2 SET DIE="^ACRDOC("
+3 SET DR=".04////35;.25T;113110DATE PURCHASED......"
+4 IF $PIECE($GET(^ACRDOC(ACRDOCDA,"REQ2")),U,8)=""
SET DR=DR_";113370////"_DUZ
+5 IF $PIECE($GET(^ACRDOC(ACRDOCDA,0)),U,14)=""
SET DR=DR_";.14////CREDIT CARD PUR"
+6 WRITE !
+7 DO DIE^ACRFDIC
+8 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,25)=""
Begin DoDot:1
+9 WRITE !!,"You must enter the name of the CREDIT CARD HOLDER for this purchase."
End DoDot:1
GOTO CC1
+10 QUIT
RECEIVER ;EP;EDIT RECEIVING OFFICIAL FOR REQ FOR SERVICE AND CALL IF CALL
+1 IF $PIECE($GET(^ACRDOC(+$GET(ACRDOCDA),0)),U,4)=35
QUIT
+2 SET DA=ACRDOCDA
+3 SET DIE="^ACRDOC("
+4 SET DR="113200T"_$SELECT($PIECE(^ACRDOC(ACRDOCDA,0),U,19):";24T",1:"")
+5 WRITE !
+6 DO DIE^ACRFDIC
CIS ;ENTER SMALL PURCHASE DATA
+1 IF ACRREF=103!(ACRREF=349)!(ACRREF=326)
IF $DATA(ACRPO)
IF '$PIECE(^ACRDOC(ACRDOCDA,0),U,16)
IF $DATA(^("PO"))
IF $PIECE(^("PO"),U,5)
IF $DATA(^AUTTVNDR($PIECE(^("PO"),U,5),0))
DO ADD^ACRFCIS
+2 QUIT
CALLERS ;EP;TO EDIT BPA CALLERS
+1 IF $DATA(ACRPO)
SET ACRDOC0=^ACRDOC(ACRDOCDA,0)
Begin DoDot:1
+2 IF $PIECE(ACRDOC0,U,18)>0!$PIECE(ACRDOC0,U,15)
Begin DoDot:2
+3 IF $PIECE(ACRDOC0,U,15)
IF '$DATA(^ACRDOC($PIECE(ACRDOC0,U,15),0))
QUIT
IF $PIECE(^(0),U,18)'>0
QUIT
SET DA=$PIECE(ACRDOC0,U,15)
+4 IF '$TEST
SET DA=ACRDOCDA
+5 SET DIE="^ACRDOC("
+6 SET DR="[ACR BPA CALL LIMIT]"
+7 DO DDS^ACRFDIC
+8 IF '$DATA(ACRSCREN)
QUIT
+9 KILL ACRSCREN
+10 WRITE !
+11 DO DIE^ACRFDIC
End DoDot:2
End DoDot:1
+12 QUIT
+1 WRITE !
+2 SET DA=ACRDOCDA
+3 SET DIE="^ACRDOC("
+4 SET DR="[ACR TRAINING OTHER DATA]"
+5 DO DDS^ACRFDIC
+6 IF '$DATA(ACRSCREN)
QUIT
+7 KILL ACRSCREN
+8 DO DIE^ACRFDIC
+9 QUIT
DRAFT ;EP;TO DETERMINE IF DRAFT PAYMENT IS ALLOWED
+1 SET DA=ACRDOCDA
+2 SET DIE="^ACRDOC("
+3 SET DR=".12Is DRAFT PAYMENT authorized"
+4 WRITE !
+5 DO DIE^ACRFDIC
+6 QUIT
PVENDOR ;EP;TO ENTER PRIME VENDOR CONTRACT NUMBER FOR THE DOCUMENT
+1 IF $PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5)'=$PIECE($GET(^ACRSYS(1,"DT1")),U,12)
QUIT
+2 IF $PIECE($GET(^ACRDOC(ACRDOCDA,"REQ2")),U,13)]""
Begin DoDot:1
+3 NEW ACR1
+4 SET DA=ACRDOCDA
+5 SET DIE="^ACRDOC("
+6 SET DR="113420T"
+7 DO DIE^ACRFDIC
+8 SET ACR1=$PIECE($GET(^ACRDOC(ACRDOCDA,"REQ2")),U,13)
+9 IF ACR1=""
QUIT
+10 DO DOC^ACRFPVEN
End DoDot:1
QUIT
+11 DO POS^ACRFPVEN
+12 QUIT
PRINT ;EP;TO PRINT ACCOUNT AUDIT
+1 FOR
DO P1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
P1 ;
+1 WRITE @IOF
+2 WRITE !?10,"Select Account for AUDIT REPORT"
+3 SET DIR(0)="SO^1:Appropriation;2:Allowance;3:Sub-Allowance;4:Department Account"
+4 SET DIR("A")="Which type of account"
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF 'Y
SET ACRQUIT=""
QUIT
+8 IF Y=1
SET ACRGLB="^ACRAPP"
+9 IF Y=2
SET ACRGLB="^ACRALW"
+10 IF Y=3
SET ACRGLB="^ACRALC"
+11 IF Y=4
SET ACRGLB="^ACRLOCB"
+12 SET DIC=ACRGLB_"("
+13 SET DIC(0)="AEMQZ"
+14 SET DIC("A")="Which "_$SELECT(Y=1:"APPROPRIATION",Y=2:"ALLOWANCE",Y=3:"SUB-ALLOWANCE",1:"DEPARTMENT ACCOUNT")_": "
+15 SET DIC("S")="I $P(^(0),U,8)=""O"",$D(@ACRGLB@(""ORIG"",+Y))"
+16 WRITE !
+17 DO DIC^ACRFDIC
+18 IF +Y<1
QUIT
+19 SET ACRZDA=+Y
ZIS SET ZTDESC="ACCOUNT AUDIT REPORT"
+1 SET (ZTRTN,ACRRTN)="P2^ACRFEA43"
+2 DO ^ACRFZIS
+3 QUIT
P2 ;EP;TO PRINT ACCOUNT AUDIT REPORT
+1 NEW ACRTOT,ACRAMT,ACRCMT
+2 DO PHEAD
+3 SET ACRX=@ACRGLB@(ACRZDA,0)
SET ACRDT=$GET(@ACRGLB@(ACRZDA,"DT"))
SET ACRCMT=$GET(@ACRGLB@(ACRZDA,"PURP"))
+4 WRITE !,ACRZDA,?7,$PIECE(ACRX,U,8),?9,$EXTRACT($SELECT(ACRGLB'["ACRLOCB":$PIECE(ACRX,U,12),1:$PIECE($GET(^AUTTPRG(+...
... $PIECE(ACRX,U,5),0)),U)),1,25),?35,$PIECE(ACRDT,U,3),?37,$EXTRACT($PIECE(ACRCMT,U),1,30),?68,$JUSTIFY($FNUMBER(+ACRX+$SELECT(ACRGLB["ACRLOCB":$PIECE(ACRX,U,11),1:0),"P",2),12)
+5 SET ACRTOT=+ACRX+$SELECT(ACRGLB["ACRLOCB":$PIECE(ACRX,U,11),1:0)
+6 SET ACRDA=0
+7 FOR
SET ACRDA=$ORDER(@ACRGLB@("ORIG",ACRZDA,ACRDA))
IF 'ACRDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+8 SET ACRX=@ACRGLB@(ACRDA,0)
SET ACRDT=$GET(@ACRGLB@(ACRDA,"DT"))
SET ACRCMT=$GET(@ACRGLB@(ACRDA,"PURP"))
+9 WRITE !,ACRDA,?7,$PIECE(ACRX,U,8),?9,$EXTRACT($SELECT(ACRGLB'["ACRLOCB":$PIECE(ACRX,U,12),1:$PIECE($GET(^AUTTPRG(+$PIECE(ACRX,U,5),0)),U)),1,25),?35,...
... $PIECE(ACRDT,U,3),?37,$EXTRACT($PIECE(ACRCMT,U),1,30),?68,$JUSTIFY($FNUMBER(+ACRX+$SELECT(ACRGLB["ACRLOCB":$PIECE(ACRX,U,11),1:0),"P",2),12)
+10 SET ACRAMT=$SELECT($PIECE(ACRX,U,8)'="D":1,1:-1)
+11 SET ACRTOT=ACRTOT+(+ACRX*ACRAMT)+$SELECT(ACRGLB["ACRLOCB":$PIECE(ACRX,U,11),1:0)
+12 IF IOSL-4<$Y
DO PAUSE^ACRFWARN
IF $DATA(ACRQUIT)
QUIT
DO PHEAD
End DoDot:1
+13 DO PTAIL
+14 KILL ACRQUIT
+15 DO PAUSE^ACRFWARN
+16 QUIT
PHEAD ;
+1 WRITE @IOF
+2 WRITE !,"Audit of ",$SELECT(ACRGLB["ACRAPP":"APPROPRIATION",ACRGLB["ACRALW":"ALLOWANCE",ACRGLB["ACRALC":"SUB-ALLOWANCE",1:"DEPARTMENT ACCOUNT")," Increases and Decreases."
+3 WRITE !!,"REPORT DATE: "
+4 SET Y=DT
+5 XECUTE ^DD("DD")
+6 WRITE Y,?35,"R"
+7 WRITE !?35,"E",!,"ID NO.",?9,"ACCOUNT IDENTIFER",?35,"C",?37,"PURPOSE",?68,"AMOUNT"
+8 WRITE !,"------",?7,"-",?9,"-------------------------",?35,"-",?37,"------------------------------",?68,"------------"
+9 QUIT
PTAIL ;
+1 WRITE !,"------",?7,"-",?9,"-------------------------",?35,"-",?37,"------------------------------",?68,"------------"
+2 WRITE !?30,"TOTAL: ",?68,$JUSTIFY($FNUMBER(ACRTOT,"P",2),12)
+3 QUIT
