- 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