ACRFRR3 ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORT/INVOICE AUDIT CONT'D; [ 09/23/2005 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
;;CONTINUATION OF ACRFRR
EORA ;EP;EDIT OR ADD RECEIVING REPORT
I $D(ACRRR)#2,'$D(^ACRAPL("AC",DUZ,7)) D Q
.W !!,"You do not have authority to sign as a Receiving Agent."
.W !,"Contact your ARMS Systems Manager if you should have this authority."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
.K ACRFINAL
I $D(ACRIV)#2,'$D(^ACRAPL("AC",DUZ,42)) D Q
.W !!,"You do not have authority to sign as an Invoice Auditor."
.W !,"Contact your ARMS Systems Manager if you should have this authority."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
.K ACRFINAL
S ACRDUZ=$S($D(ACRRR)#2:$P(^ACRDOC(ACRDOCDA,"REQ1"),U,6),1:$P(^ACRDOC(ACRDOCDA,"POIO"),U,8))
I 'ACRDUZ D Q
.W !!,"No ",$S($D(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")
.W " is specified for this Purchase Order."
.W !,"Please contact your ARMS Systems Manager for assistance."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
.K ACRFINAL
I DUZ'=ACRDUZ,'$D(^ACRAPL("ALT",ACRDUZ,$S($D(ACRRR)#2:7,1:42),DUZ)) D Q:$D(ACRQUIT)
.N X,Y
.S Y=0
.F S Y=$O(^ACRSS("J",ACRDOCDA,Y)) Q:'Y!$D(ACRQUIT) D
..S X=$P(^ACRSS(Y,0),U,3)
..S X=$P($G(^ACRDOC(X,"REQ1")),U,6)
..I X=DUZ!$D(^ACRAPL("ALT",X,$S($D(ACRRR)#2:7,1:42),DUZ)) S ACRQUIT=""
.I $D(ACRQUIT) K ACRQUIT Q
.;S ACRDUZ=$P(^VA(200,ACRDUZ,0),U) ;ACR*2.1*19.02 IM16848
.S ACRDUZ=$$NAME2^ACRFUTL1(ACRDUZ) ;ACR*2.1*19.02 IM16848
.S ACRDUZ=$P($P(ACRDUZ,",",2)," ")_" "_$P(ACRDUZ,",")
.W !!,"You are not the designated "
.W $S($D(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")
.W " for this Purchase Order,"
.W !,"nor are you an alternate to the designated "
.W $S($D(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")
.W !!,"Contact ",ACRDUZ," or his/her authorized alternate to complete"
.W !,"this "
.W $S($D(ACRRR)#2:"receiving action.",1:"invoice audit.")
.D PAUSE^ACRFWARN
.S ACRQUIT=""
.K ACRFINAL
K ACRRRADD
I $D(ACRIV)#2,$P(^ACRDOC(ACRDOCDA,"PO"),U,16)]"" S ACRIVNO=$P(^("PO"),U,16)
E I $D(ACRIV)#2,$P(^ACRDOC(ACRDOCDA,"PO"),U,16)="" D
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="103200T;103200.1T"
.W !
.D DIE^ACRFDIC
.S ACRIVNO=$P(^ACRDOC(ACRDOCDA,"PO"),U,16)
I $D(ACRRR)#2 D
.S DIR(0)="SO^1:Add Receiving Report;2:Cancel an Item"
.I $D(^ACRRR("C",ACRDOCDA)) D
..S DIR(0)=DIR(0)_";3:Edit Receiving Report by Item;4:Edit Receiving Report by Report"
I $D(ACRIV)#2 D ^ACRFIV Q
S DIR(0)=DIR(0)_";P:Print Receiving Report"
S DIR("A")="Which one"
D DIR^ACRFDIC
S ACRFINAL=0
Q:(1234'[Y&(Y'="P"))!$D(ACRQUIT)!$D(ACROUT)
I Y,$D(ACRIV)#2 S Y=Y+2
I Y=1 S ACRRRADD="" D ADD^ACRFRR33 S Y=1
I Y=2 D CANCEL^ACRFRR2 S Y=1
I Y=3 D ITEM K ACRQUIT S Y=1
I Y=4 D SELECT S Y=1
I Y="P" D P11^ACRFPO1 K ACRQUIT
S ACRFINAL=0
Q
SELECT ;EP;SELECT RECEIVING REPORT TO EDIT
F D S1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
S1 ;EP;
S (X,Z)=0
F S X=$O(^ACRRR("AC",ACRDOCDA,X)) Q:'X S Z=Z+1
I Z=0 D Q
.W !!,"No Receiving Reports on file for this document."
.D PAUSE^ACRFWARN
I Z=1 D Q
.S (ACRRRNO,Y)=1
.D S2
.S ACRQUIT=""
S DIR(0)="NO^1:"_Z
S DIR("A")="Which Receiving Report"
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)!'Y
S ACRRRNO=Y
S2 D BYRR^ACRFRR32
Q
ITEM ;EP;TO AUDIT BY ITEM
F D I1 Q:$D(ACRQUIT)!$D(ACROUT)
Q
I1 I ACRSSMAX=1 S ACRXX=+ACRSS0 G ITEM1
S DIR(0)="LO^1:"_ACRSSMAX
S DIR("A")="Which item(s)"
W !
D DIR^ACRFDIC
Q:'+Y!$D(ACRQUIT)!$D(ACROUT)
S ACRXX=Y
I $G(Y(1))]"" S %X="Y(",%Y="ACRXX(" D %XY^%RCR
D ITEM1
N ACRJJ
S ACRJJ=0
F S ACRJJ=$O(ACRXX(ACRJJ)) Q:'ACRJJ S ACRXX=ACRXX(ACRJJ) D ITEM1
Q
ITEM1 F ACRK=1:1 S ACRSSNO=$P(ACRXX,",",ACRK) Q:'ACRSSNO S ACRSSDA=+$G(ACRSS(ACRSSNO)) D:ACRSSDA DISPLAY^ACRFRR32
S ACRQUIT=""
Q
IADD ;EP;
Q:'$G(ACRRRNO)
I '$D(^ACRDOC(ACRDOCDA,20,"B",ACRRRNO)) D
.S:'$D(^ACRDOC(ACRDOCDA,20,0)) ^(0)="^9002196.2001"
.S DA(1)=ACRDOCDA
.S DINUM=ACRRRNO
.S X=$S($D(ACRIVNO):ACRIVNO,1:$P(^ACRDOC(ACRDOCDA,"PO"),U,16))
.Q:X=""
.S DIC="^ACRDOC("_DA(1)_",20,"
.S DIC(0)="L"
.S DIC("DR")=".02////"_$P($G(^ACRDOC(ACRDOCDA,"PO")),U,21)_";.03////"_$P($G(^ACRDOC(ACRDOCDA,5)),U,6)
.D FILE^ACRFDIC
Q
ACRFRR3 ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORT/INVOICE AUDIT CONT'D; [ 09/23/2005 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFRR
EORA ;EP;EDIT OR ADD RECEIVING REPORT
+1 IF $DATA(ACRRR)#2
IF '$DATA(^ACRAPL("AC",DUZ,7))
Begin DoDot:1
+2 WRITE !!,"You do not have authority to sign as a Receiving Agent."
+3 WRITE !,"Contact your ARMS Systems Manager if you should have this authority."
+4 DO PAUSE^ACRFWARN
+5 SET ACRQUIT=""
+6 KILL ACRFINAL
End DoDot:1
QUIT
+7 IF $DATA(ACRIV)#2
IF '$DATA(^ACRAPL("AC",DUZ,42))
Begin DoDot:1
+8 WRITE !!,"You do not have authority to sign as an Invoice Auditor."
+9 WRITE !,"Contact your ARMS Systems Manager if you should have this authority."
+10 DO PAUSE^ACRFWARN
+11 SET ACRQUIT=""
+12 KILL ACRFINAL
End DoDot:1
QUIT
+13 SET ACRDUZ=$SELECT($DATA(ACRRR)#2:$PIECE(^ACRDOC(ACRDOCDA,"REQ1"),U,6),1:$PIECE(^ACRDOC(ACRDOCDA,"POIO"),U,8))
+14 IF 'ACRDUZ
Begin DoDot:1
+15 WRITE !!,"No ",$SELECT($DATA(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")
+16 WRITE " is specified for this Purchase Order."
+17 WRITE !,"Please contact your ARMS Systems Manager for assistance."
+18 DO PAUSE^ACRFWARN
+19 SET ACRQUIT=""
+20 KILL ACRFINAL
End DoDot:1
QUIT
+21 IF DUZ'=ACRDUZ
IF '$DATA(^ACRAPL("ALT",ACRDUZ,$SELECT($DATA(ACRRR)#2:7,1:42),DUZ))
Begin DoDot:1
+22 NEW X,Y
+23 SET Y=0
+24 FOR
SET Y=$ORDER(^ACRSS("J",ACRDOCDA,Y))
IF 'Y!$DATA(ACRQUIT)
QUIT
Begin DoDot:2
+25 SET X=$PIECE(^ACRSS(Y,0),U,3)
+26 SET X=$PIECE($GET(^ACRDOC(X,"REQ1")),U,6)
+27 IF X=DUZ!$DATA(^ACRAPL("ALT",X,$SELECT($DATA(ACRRR)#2:7,1:42),DUZ))
SET ACRQUIT=""
End DoDot:2
+28 IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
+29 ;S ACRDUZ=$P(^VA(200,ACRDUZ,0),U) ;ACR*2.1*19.02 IM16848
+30 ;ACR*2.1*19.02 IM16848
SET ACRDUZ=$$NAME2^ACRFUTL1(ACRDUZ)
+31 SET ACRDUZ=$PIECE($PIECE(ACRDUZ,",",2)," ")_" "_$PIECE(ACRDUZ,",")
+32 WRITE !!,"You are not the designated "
+33 WRITE $SELECT($DATA(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")
+34 WRITE " for this Purchase Order,"
+35 WRITE !,"nor are you an alternate to the designated "
+36 WRITE $SELECT($DATA(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")
+37 WRITE !!,"Contact ",ACRDUZ," or his/her authorized alternate to complete"
+38 WRITE !,"this "
+39 WRITE $SELECT($DATA(ACRRR)#2:"receiving action.",1:"invoice audit.")
+40 DO PAUSE^ACRFWARN
+41 SET ACRQUIT=""
+42 KILL ACRFINAL
End DoDot:1
IF $DATA(ACRQUIT)
QUIT
+43 KILL ACRRRADD
+44 IF $DATA(ACRIV)#2
IF $PIECE(^ACRDOC(ACRDOCDA,"PO"),U,16)]""
SET ACRIVNO=$PIECE(^("PO"),U,16)
+45 IF '$TEST
IF $DATA(ACRIV)#2
IF $PIECE(^ACRDOC(ACRDOCDA,"PO"),U,16)=""
Begin DoDot:1
+46 SET DA=ACRDOCDA
+47 SET DIE="^ACRDOC("
+48 SET DR="103200T;103200.1T"
+49 WRITE !
+50 DO DIE^ACRFDIC
+51 SET ACRIVNO=$PIECE(^ACRDOC(ACRDOCDA,"PO"),U,16)
End DoDot:1
+52 IF $DATA(ACRRR)#2
Begin DoDot:1
+53 SET DIR(0)="SO^1:Add Receiving Report;2:Cancel an Item"
+54 IF $DATA(^ACRRR("C",ACRDOCDA))
Begin DoDot:2
+55 SET DIR(0)=DIR(0)_";3:Edit Receiving Report by Item;4:Edit Receiving Report by Report"
End DoDot:2
End DoDot:1
+56 IF $DATA(ACRIV)#2
DO ^ACRFIV
QUIT
+57 SET DIR(0)=DIR(0)_";P:Print Receiving Report"
+58 SET DIR("A")="Which one"
+59 DO DIR^ACRFDIC
+60 SET ACRFINAL=0
+61 IF (1234'[Y&(Y'="P"))!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+62 IF Y
IF $DATA(ACRIV)#2
SET Y=Y+2
+63 IF Y=1
SET ACRRRADD=""
DO ADD^ACRFRR33
SET Y=1
+64 IF Y=2
DO CANCEL^ACRFRR2
SET Y=1
+65 IF Y=3
DO ITEM
KILL ACRQUIT
SET Y=1
+66 IF Y=4
DO SELECT
SET Y=1
+67 IF Y="P"
DO P11^ACRFPO1
KILL ACRQUIT
+68 SET ACRFINAL=0
+69 QUIT
SELECT ;EP;SELECT RECEIVING REPORT TO EDIT
+1 FOR
DO S1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
S1 ;EP;
+1 SET (X,Z)=0
+2 FOR
SET X=$ORDER(^ACRRR("AC",ACRDOCDA,X))
IF 'X
QUIT
SET Z=Z+1
+3 IF Z=0
Begin DoDot:1
+4 WRITE !!,"No Receiving Reports on file for this document."
+5 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+6 IF Z=1
Begin DoDot:1
+7 SET (ACRRRNO,Y)=1
+8 DO S2
+9 SET ACRQUIT=""
End DoDot:1
QUIT
+10 SET DIR(0)="NO^1:"_Z
+11 SET DIR("A")="Which Receiving Report"
+12 WRITE !
+13 DO DIR^ACRFDIC
+14 IF $DATA(ACRQUIT)!$DATA(ACROUT)!'Y
QUIT
+15 SET ACRRRNO=Y
S2 DO BYRR^ACRFRR32
+1 QUIT
ITEM ;EP;TO AUDIT BY ITEM
+1 FOR
DO I1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 QUIT
I1 IF ACRSSMAX=1
SET ACRXX=+ACRSS0
GOTO ITEM1
+1 SET DIR(0)="LO^1:"_ACRSSMAX
+2 SET DIR("A")="Which item(s)"
+3 WRITE !
+4 DO DIR^ACRFDIC
+5 IF '+Y!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+6 SET ACRXX=Y
+7 IF $GET(Y(1))]""
SET %X="Y("
SET %Y="ACRXX("
DO %XY^%RCR
+8 DO ITEM1
+9 NEW ACRJJ
+10 SET ACRJJ=0
+11 FOR
SET ACRJJ=$ORDER(ACRXX(ACRJJ))
IF 'ACRJJ
QUIT
SET ACRXX=ACRXX(ACRJJ)
DO ITEM1
+12 QUIT
ITEM1 FOR ACRK=1:1
SET ACRSSNO=$PIECE(ACRXX,",",ACRK)
IF 'ACRSSNO
QUIT
SET ACRSSDA=+$GET(ACRSS(ACRSSNO))
IF ACRSSDA
DO DISPLAY^ACRFRR32
+1 SET ACRQUIT=""
+2 QUIT
IADD ;EP;
+1 IF '$GET(ACRRRNO)
QUIT
+2 IF '$DATA(^ACRDOC(ACRDOCDA,20,"B",ACRRRNO))
Begin DoDot:1
+3 IF '$DATA(^ACRDOC(ACRDOCDA,20,0))
SET ^(0)="^9002196.2001"
+4 SET DA(1)=ACRDOCDA
+5 SET DINUM=ACRRRNO
+6 SET X=$SELECT($DATA(ACRIVNO):ACRIVNO,1:$PIECE(^ACRDOC(ACRDOCDA,"PO"),U,16))
+7 IF X=""
QUIT
+8 SET DIC="^ACRDOC("_DA(1)_",20,"
+9 SET DIC(0)="L"
+10 SET DIC("DR")=".02////"_$PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,21)_";.03////"_$PIECE($GET(^ACRDOC(ACRDOCDA,5)),U,6)
+11 DO FILE^ACRFDIC
End DoDot:1
+12 QUIT
