ACRFIV31 ;IHS/OIRM/DSD/THL,AEF - INVOICE AUDITS CONTINUED; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE CALLED DURING PROCESSING OF INVOICES
INVOICE ;EP
D TOTACP1
I ACRIVDX'<ACRACP D
.W !!,ACRACP," of these items ",$S(ACRRQD=1:"was",1:"were")," recieved and accepted,"
.W !,ACRIVDX,$S(ACRIVDX=1:" has",1:" have")," already been invoiced."
.W !,"No further invoice action should be taken for this item."
.D PAUSE^ACRFWARN
S DIR(0)="NOA^-999999:9999999:3"
S DIR("A")="UNIT COST...........: "
S DIR("?")="Enter the actual UNIT COST of the item from the invoice"
S DIR("B")=ACRUC
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) D INCOMPLT Q
S ACRUCX=Y
S DIR(0)="NOA^0:"_ACRUNINV
S DIR("A")="NUMBER INVOICED.....: "
S DIR("?")="Enter the actual number on the invoice"
S DIR("B")=ACRUNACP
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) D INCOMPLT Q
S ACRIVDX=Y,ACRIVD=ACRIVD+Y
D DATE
D ADD
Q
ADD ;EP;ADD INVOICE AUDIT
D NOW^%DTC
S ACRDATE=%
S DA=ACRRRDA
S ACRACPX=$P(^ACRRR(DA,"DT"),U,3)
S ACRSSDA=+^ACRRR(DA,0)
S ACRUCX=$P(^ACRSS(ACRSSDA,"DT"),U,3)
S DIE="^ACRRR("
S DR=".09////"_DUZ_";.1////"_%_";5////"_ACRUCX_";6////"_ACRACPX_";7////"_ACRIVNO
D DIE^ACRFDIC
S X=ACRDATE
S DA(1)=ACRRRDA
S DIC(0)="L"
S DIC="^ACRRR("_ACRRRDA_",12,"
S DIC("DR")=".02////"_DUZ_";.03////1"
S:'$D(@(DIC_"0)")) ^ACRRR(ACRRRDA,12,0)="^9002193.2121D"
D FILE^ACRFDIC
C1 ;EP;
D TOTAL
S DA=ACRSSDA
S DIE="^ACRSS("
S DR="16////"_(ACRIVD*ACRUC)_";17////"_ACRIVD_";32////"_ACRUC
D DIE^ACRFDIC
Q
INCOMPLT W !!,*7,*7,"Data entry for ITEM NO. ",ACRJ," not completed, entry not accepted."
H 2
K ACRQUIT
Q
TOTAL S (X,ACRIVD,ACRUC,ACRACP)=0
F S X=$O(^ACRRR("B",ACRSSDA,X)) Q:'X D
.I $D(^ACRRR(X,"DT")) S ACRRRDT=^("DT") D
..S ACRACP=ACRACP+$P(ACRRRDT,U,3)
..S ACRIVD=ACRIVD+$P(ACRRRDT,U,6)
..S:$P(ACRRRDT,U,5)>ACRUC ACRUC=$P(ACRRRDT,U,5)
Q
RRNO ;EP;TO DETERMINE THE NO OF RECEIVING REPORTS ON FILE
S (X,Z)=0
F S X=$O(^ACRRR("AC",ACRDOCDA,X)) Q:'X S Z=Z+1
S ACRRRNO=Z
Q
TOTCHK ;EP;CALLED BY INPUT TRANSFOR TO ENSURE THAT THE QUANTITY INVOICED ON A
;INVOICE AUDIT DOES NOT MAKE THE TOTAL QUANTITY INVOICED GREATER THAN
;TOTAL QUANTITY RECEIVED AND ACCEPTED
D TOTACP
S:$D(^ACRRR(DA,"DT")) ACRIVDX=ACRIVD-$P(^("DT"),U,2)
I ACRIVDX+X>ACRACP D
.W !!,*7,*7
.W "The quantity received on this receiving action cannot make the total quantity"
.W !,"received greater than the total quantity ordered (",ACRRQD,")"
.W !
.K X
Q
TOTACP ;EP;TO CALCULATE THE TOTAL INVOICED FOR AN ITEM
S ACRIVDX=0
I '$D(ACRRRDA),'$D(DA) D TOTACP1 Q
I '$D(DA),$D(ACRRRDA) S DA=ACRRRDA
N ACRRRDA,ACRSSDA
S ACRRRDA=DA
Q:'$D(^ACRRR(DA,0)) S ACRSSDA=+^(0)
TOTACP1 Q:'$D(^ACRSS(ACRSSDA,"DT")) S ACRACP=$P(^("DT"),U,3)
S (ACRIVD,ACRRRX,ACRACP)=0
F S ACRRRX=$O(^ACRRR("B",ACRSSDA,ACRRRX)) Q:'ACRRRX S:$D(^ACRRR(ACRRRX,"DT")) ACRRRDT=^("DT"),ACRIVD=ACRIVD+$P(ACRRRDT,U,6)
K ACRRRX
Q
DATE ;
S DIR(0)="DOA^::E"
S DIR("A")="DATE INVOICED.......: "
S DIR("?")="Enter the date the items were actually received"
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) D INCOMPLT Q
S ACRDATE=Y
Q
ALL ;EP;TO UP-DATE ALL INVOICED ITEMS BASED ON THE RECEIVING REPORT
Q:'$D(ACRRR)#2
S X=0,Y=""
F S X=$O(^TMP("ACRRR",$J,X)) Q:'X S Y=Y_X_","
Q:'+Y
S ACRIVY=Y
W !!,"The following procedure will update the invoice record to show that the"
W !,"quantities and costs on the invoice are the same as the quantities and costs"
W !,"shown on this receiving report."
S DIR(0)="YO"
S DIR("A")="Do you want to proceed"
S DIR("B")="NO"
S DIR("?")="Enter 'Y' to proceed with this update, 'N' to return without an invoice update."
W !
D DIR^ACRFDIC
Q:Y'=1
N ACRI
F ACRI=1:1 S Y=$P(ACRIVY,",",ACRI) Q:'Y I $D(^TMP("ACRRR",$J,Y)) S ACRRRDA=+ACRRR(Y) D ADD
Q
ACRFIV31 ;IHS/OIRM/DSD/THL,AEF - INVOICE AUDITS CONTINUED; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE CALLED DURING PROCESSING OF INVOICES
INVOICE ;EP
+1 DO TOTACP1
+2 IF ACRIVDX'<ACRACP
Begin DoDot:1
+3 WRITE !!,ACRACP," of these items ",$SELECT(ACRRQD=1:"was",1:"were")," recieved and accepted,"
+4 WRITE !,ACRIVDX,$SELECT(ACRIVDX=1:" has",1:" have")," already been invoiced."
+5 WRITE !,"No further invoice action should be taken for this item."
+6 DO PAUSE^ACRFWARN
End DoDot:1
+7 SET DIR(0)="NOA^-999999:9999999:3"
+8 SET DIR("A")="UNIT COST...........: "
+9 SET DIR("?")="Enter the actual UNIT COST of the item from the invoice"
+10 SET DIR("B")=ACRUC
+11 DO DIR^ACRFDIC
+12 IF $DATA(ACRQUIT)!$DATA(ACROUT)
DO INCOMPLT
QUIT
+13 SET ACRUCX=Y
+14 SET DIR(0)="NOA^0:"_ACRUNINV
+15 SET DIR("A")="NUMBER INVOICED.....: "
+16 SET DIR("?")="Enter the actual number on the invoice"
+17 SET DIR("B")=ACRUNACP
+18 DO DIR^ACRFDIC
+19 IF $DATA(ACRQUIT)!$DATA(ACROUT)
DO INCOMPLT
QUIT
+20 SET ACRIVDX=Y
SET ACRIVD=ACRIVD+Y
+21 DO DATE
+22 DO ADD
+23 QUIT
ADD ;EP;ADD INVOICE AUDIT
+1 DO NOW^%DTC
+2 SET ACRDATE=%
+3 SET DA=ACRRRDA
+4 SET ACRACPX=$PIECE(^ACRRR(DA,"DT"),U,3)
+5 SET ACRSSDA=+^ACRRR(DA,0)
+6 SET ACRUCX=$PIECE(^ACRSS(ACRSSDA,"DT"),U,3)
+7 SET DIE="^ACRRR("
+8 SET DR=".09////"_DUZ_";.1////"_%_";5////"_ACRUCX_";6////"_ACRACPX_";7////"_ACRIVNO
+9 DO DIE^ACRFDIC
+10 SET X=ACRDATE
+11 SET DA(1)=ACRRRDA
+12 SET DIC(0)="L"
+13 SET DIC="^ACRRR("_ACRRRDA_",12,"
+14 SET DIC("DR")=".02////"_DUZ_";.03////1"
+15 IF '$DATA(@(DIC_"0)"))
SET ^ACRRR(ACRRRDA,12,0)="^9002193.2121D"
+16 DO FILE^ACRFDIC
C1 ;EP;
+1 DO TOTAL
+2 SET DA=ACRSSDA
+3 SET DIE="^ACRSS("
+4 SET DR="16////"_(ACRIVD*ACRUC)_";17////"_ACRIVD_";32////"_ACRUC
+5 DO DIE^ACRFDIC
+6 QUIT
INCOMPLT WRITE !!,*7,*7,"Data entry for ITEM NO. ",ACRJ," not completed, entry not accepted."
+1 HANG 2
+2 KILL ACRQUIT
+3 QUIT
TOTAL SET (X,ACRIVD,ACRUC,ACRACP)=0
+1 FOR
SET X=$ORDER(^ACRRR("B",ACRSSDA,X))
IF 'X
QUIT
Begin DoDot:1
+2 IF $DATA(^ACRRR(X,"DT"))
SET ACRRRDT=^("DT")
Begin DoDot:2
+3 SET ACRACP=ACRACP+$PIECE(ACRRRDT,U,3)
+4 SET ACRIVD=ACRIVD+$PIECE(ACRRRDT,U,6)
+5 IF $PIECE(ACRRRDT,U,5)>ACRUC
SET ACRUC=$PIECE(ACRRRDT,U,5)
End DoDot:2
End DoDot:1
+6 QUIT
RRNO ;EP;TO DETERMINE THE NO OF RECEIVING REPORTS ON FILE
+1 SET (X,Z)=0
+2 FOR
SET X=$ORDER(^ACRRR("AC",ACRDOCDA,X))
IF 'X
QUIT
SET Z=Z+1
+3 SET ACRRRNO=Z
+4 QUIT
TOTCHK ;EP;CALLED BY INPUT TRANSFOR TO ENSURE THAT THE QUANTITY INVOICED ON A
+1 ;INVOICE AUDIT DOES NOT MAKE THE TOTAL QUANTITY INVOICED GREATER THAN
+2 ;TOTAL QUANTITY RECEIVED AND ACCEPTED
+3 DO TOTACP
+4 IF $DATA(^ACRRR(DA,"DT"))
SET ACRIVDX=ACRIVD-$PIECE(^("DT"),U,2)
+5 IF ACRIVDX+X>ACRACP
Begin DoDot:1
+6 WRITE !!,*7,*7
+7 WRITE "The quantity received on this receiving action cannot make the total quantity"
+8 WRITE !,"received greater than the total quantity ordered (",ACRRQD,")"
+9 WRITE !
+10 KILL X
End DoDot:1
+11 QUIT
TOTACP ;EP;TO CALCULATE THE TOTAL INVOICED FOR AN ITEM
+1 SET ACRIVDX=0
+2 IF '$DATA(ACRRRDA)
IF '$DATA(DA)
DO TOTACP1
QUIT
+3 IF '$DATA(DA)
IF $DATA(ACRRRDA)
SET DA=ACRRRDA
+4 NEW ACRRRDA,ACRSSDA
+5 SET ACRRRDA=DA
+6 IF '$DATA(^ACRRR(DA,0))
QUIT
SET ACRSSDA=+^(0)
TOTACP1 IF '$DATA(^ACRSS(ACRSSDA,"DT"))
QUIT
SET ACRACP=$PIECE(^("DT"),U,3)
+1 SET (ACRIVD,ACRRRX,ACRACP)=0
+2 FOR
SET ACRRRX=$ORDER(^ACRRR("B",ACRSSDA,ACRRRX))
IF 'ACRRRX
QUIT
IF $DATA(^ACRRR(ACRRRX,"DT"))
SET ACRRRDT=^("DT")
SET ACRIVD=ACRIVD+$PIECE(ACRRRDT,U,6)
+3 KILL ACRRRX
+4 QUIT
DATE ;
+1 SET DIR(0)="DOA^::E"
+2 SET DIR("A")="DATE INVOICED.......: "
+3 SET DIR("?")="Enter the date the items were actually received"
+4 DO DIR^ACRFDIC
+5 IF $DATA(ACRQUIT)!$DATA(ACROUT)
DO INCOMPLT
QUIT
+6 SET ACRDATE=Y
+7 QUIT
ALL ;EP;TO UP-DATE ALL INVOICED ITEMS BASED ON THE RECEIVING REPORT
+1 IF '$DATA(ACRRR)#2
QUIT
+2 SET X=0
SET Y=""
+3 FOR
SET X=$ORDER(^TMP("ACRRR",$JOB,X))
IF 'X
QUIT
SET Y=Y_X_","
+4 IF '+Y
QUIT
+5 SET ACRIVY=Y
+6 WRITE !!,"The following procedure will update the invoice record to show that the"
+7 WRITE !,"quantities and costs on the invoice are the same as the quantities and costs"
+8 WRITE !,"shown on this receiving report."
+9 SET DIR(0)="YO"
+10 SET DIR("A")="Do you want to proceed"
+11 SET DIR("B")="NO"
+12 SET DIR("?")="Enter 'Y' to proceed with this update, 'N' to return without an invoice update."
+13 WRITE !
+14 DO DIR^ACRFDIC
+15 IF Y'=1
QUIT
+16 NEW ACRI
+17 FOR ACRI=1:1
SET Y=$PIECE(ACRIVY,",",ACRI)
IF 'Y
QUIT
IF $DATA(^TMP("ACRRR",$JOB,Y))
SET ACRRRDA=+ACRRR(Y)
DO ADD
+18 QUIT
