ACRFRR33 ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORT/INVOICE AUDIT CONT'D; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;CONTINUATION OF ACRFRR
ADD ;EP;TO ADD A NEW RECEIVING REPORT
D RRNO^ACRFRR31
S ACRRRNO=ACRRRNO+1
I ACRRRNO=1 G ADD1
S DIR(0)="YO"
S DIR("A")="Add Receiving Report No. "_ACRRRNO
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:Y'=1!$D(ACRQUIT)!$D(ACROUT)
ADD1 ;EP;TO ADD ADDITIONAL ITEMS TO EXISTING RR
S ACRJ=""
K ACRDATE
W !
D DATE^ACRFRR31
Q:$D(ACRQUIT)!$D(ACROUT)
S DIR(0)="LO^1:"_ACRSSMAX
S DIR("A")="Which PO Items(s)"
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
S ACRXX=Y
I $G(Y(1))]"" S %X="Y(",%X="ACRXX(" D %XY^%RCR
S DIR(0)="SO^1:Partial "_$S($D(ACRRR)#2:"Receipt",1:"Invoice")_";2:Total "_$S($D(ACRRR)#2:"Receipt",1:"Invoice")
S DIR("B")="Partial "_$S($D(ACRRR)#2:"Receipt",1:"Invoice")
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q
I Y=2 D I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT,ACRTOTAL Q
.I $D(ACRRR)#2 D
..S DIR(0)="YO"
..S DIR("A")="Are you certain that ALL quantities ordered were RECEIVED and ACCEPTED"
.I $D(ACRIV)#2 D
..S DIR(0)="YO"
..S DIR("A",1)="Are you certain that ALL Invoice quantities and costs are identical"
..S DIR("A")="to the costs and quantities ordered and received"
.S DIR("B")="NO"
.W !
.D DIR^ACRFDIC
.I Y'=1 S ACRQUIT="" Q
.S ACRTOTAL=""
.W !
.D DATE^ACRFRR31
.I '$D(ACRDATE) S ACRQUIT="" Q
E0 D:$E($G(IOST),1,2)="C-" WAIT^DICD
D E01
N ACRJJ
S ACRJJ=0
F S ACRJJ=$O(ACRXX(ACRJJ)) Q:'ACRJJ S ACRXX=ACRXX(ACRJJ) D E01
Q
E01 F ACRK=1:1:$L(ACRXX,",") S ACRX=$P(ACRXX,",",ACRK) Q:ACRX="" D E1:$D(ACRSS(ACRX))#2
K ACRTOTAL
Q
E1 S ACRX=ACRSS(ACRX)
S ACRSSDA=+ACRX
S ACRSS0=^ACRSS(ACRSSDA,0)
S ACRSSDT=^ACRSS(ACRSSDA,"DT")
S ACRUC=$P(ACRSSDT,U,3)
S ACRRCD=$P(ACRSSDT,U,5)
S ACRACP=$P(ACRSSDT,U,6)
S ACRSSRQ=$P(ACRSS0,U,2)
S ACRSSPO=+^ACRSS(ACRSSDA,"PO")
S ACRUNRCD=+ACRSSDT-ACRACP
S ACRIVD=$P(ACRSSDT,U,19)
S ACRUNINV=ACRACP-ACRIVD,ACRIVDX=ACRUNINV
I $D(ACRRR)#2,ACRUNRCD=0 D Q
.W !!,"No additional quantities need to be received for this item."
.D PAUSE^ACRFWARN
I $D(ACRIV)#2,ACRUNINV=0 D Q
.W !!,"No additional quantities need to be invoiced for this item."
.D PAUSE^ACRFWARN
I $D(ACRTOTAL),ACRUNRCD>0 D Q
.S (ACRRCD,ACRRCDX,ACRACP,ACRACPX)=ACRUNRCD
.D ADD^ACRFRR31:$D(ACRRR)#2
.D ADD^ACRFIV31:$D(ACRIV)#2
.K ACRQUIT
D EDIE
Q
EDIE W @IOF
W !?20,"INFORMATION FOR SELECTED "
W !?20,@ACRON,"SERVICE OR SUPPLY",@ACROF
W !!
N DXS,DIP,DC,DN,D0
S D0=ACRSSDA
D ^ACRPII
W !!
D:$D(ACRRR)#2 ^ACRFRR31
D:$D(ACRIV)#2 ^ACRFIV31
Q
ACRFRR33 ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORT/INVOICE AUDIT CONT'D; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFRR
ADD ;EP;TO ADD A NEW RECEIVING REPORT
+1 DO RRNO^ACRFRR31
+2 SET ACRRRNO=ACRRRNO+1
+3 IF ACRRRNO=1
GOTO ADD1
+4 SET DIR(0)="YO"
+5 SET DIR("A")="Add Receiving Report No. "_ACRRRNO
+6 SET DIR("B")="NO"
+7 WRITE !
+8 DO DIR^ACRFDIC
+9 IF Y'=1!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
ADD1 ;EP;TO ADD ADDITIONAL ITEMS TO EXISTING RR
+1 SET ACRJ=""
+2 KILL ACRDATE
+3 WRITE !
+4 DO DATE^ACRFRR31
+5 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+6 SET DIR(0)="LO^1:"_ACRSSMAX
+7 SET DIR("A")="Which PO Items(s)"
+8 WRITE !
+9 DO DIR^ACRFDIC
+10 IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+11 SET ACRXX=Y
+12 IF $GET(Y(1))]""
SET %X="Y("
SET %X="ACRXX("
DO %XY^%RCR
+13 SET DIR(0)="SO^1:Partial "_$SELECT($DATA(ACRRR)#2:"Receipt",1:"Invoice")_";2:Total "_$SELECT($DATA(ACRRR)#2:"Receipt",1:"Invoice")
+14 SET DIR("B")="Partial "_$SELECT($DATA(ACRRR)#2:"Receipt",1:"Invoice")
+15 WRITE !
+16 DO DIR^ACRFDIC
+17 IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT
QUIT
+18 IF Y=2
Begin DoDot:1
+19 IF $DATA(ACRRR)#2
Begin DoDot:2
+20 SET DIR(0)="YO"
+21 SET DIR("A")="Are you certain that ALL quantities ordered were RECEIVED and ACCEPTED"
End DoDot:2
+22 IF $DATA(ACRIV)#2
Begin DoDot:2
+23 SET DIR(0)="YO"
+24 SET DIR("A",1)="Are you certain that ALL Invoice quantities and costs are identical"
+25 SET DIR("A")="to the costs and quantities ordered and received"
End DoDot:2
+26 SET DIR("B")="NO"
+27 WRITE !
+28 DO DIR^ACRFDIC
+29 IF Y'=1
SET ACRQUIT=""
QUIT
+30 SET ACRTOTAL=""
+31 WRITE !
+32 DO DATE^ACRFRR31
+33 IF '$DATA(ACRDATE)
SET ACRQUIT=""
QUIT
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
KILL ACRQUIT,ACRTOTAL
QUIT
E0 IF $EXTRACT($GET(IOST),1,2)="C-"
DO WAIT^DICD
+1 DO E01
+2 NEW ACRJJ
+3 SET ACRJJ=0
+4 FOR
SET ACRJJ=$ORDER(ACRXX(ACRJJ))
IF 'ACRJJ
QUIT
SET ACRXX=ACRXX(ACRJJ)
DO E01
+5 QUIT
E01 FOR ACRK=1:1:$LENGTH(ACRXX,",")
SET ACRX=$PIECE(ACRXX,",",ACRK)
IF ACRX=""
QUIT
IF $DATA(ACRSS(ACRX))#2
DO E1
+1 KILL ACRTOTAL
+2 QUIT
E1 SET ACRX=ACRSS(ACRX)
+1 SET ACRSSDA=+ACRX
+2 SET ACRSS0=^ACRSS(ACRSSDA,0)
+3 SET ACRSSDT=^ACRSS(ACRSSDA,"DT")
+4 SET ACRUC=$PIECE(ACRSSDT,U,3)
+5 SET ACRRCD=$PIECE(ACRSSDT,U,5)
+6 SET ACRACP=$PIECE(ACRSSDT,U,6)
+7 SET ACRSSRQ=$PIECE(ACRSS0,U,2)
+8 SET ACRSSPO=+^ACRSS(ACRSSDA,"PO")
+9 SET ACRUNRCD=+ACRSSDT-ACRACP
+10 SET ACRIVD=$PIECE(ACRSSDT,U,19)
+11 SET ACRUNINV=ACRACP-ACRIVD
SET ACRIVDX=ACRUNINV
+12 IF $DATA(ACRRR)#2
IF ACRUNRCD=0
Begin DoDot:1
+13 WRITE !!,"No additional quantities need to be received for this item."
+14 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+15 IF $DATA(ACRIV)#2
IF ACRUNINV=0
Begin DoDot:1
+16 WRITE !!,"No additional quantities need to be invoiced for this item."
+17 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+18 IF $DATA(ACRTOTAL)
IF ACRUNRCD>0
Begin DoDot:1
+19 SET (ACRRCD,ACRRCDX,ACRACP,ACRACPX)=ACRUNRCD
+20 IF $DATA(ACRRR)#2
DO ADD^ACRFRR31
+21 IF $DATA(ACRIV)#2
DO ADD^ACRFIV31
+22 KILL ACRQUIT
End DoDot:1
QUIT
+23 DO EDIE
+24 QUIT
EDIE WRITE @IOF
+1 WRITE !?20,"INFORMATION FOR SELECTED "
+2 WRITE !?20,@ACRON,"SERVICE OR SUPPLY",@ACROF
+3 WRITE !!
+4 NEW DXS,DIP,DC,DN,D0
+5 SET D0=ACRSSDA
+6 DO ^ACRPII
+7 WRITE !!
+8 IF $DATA(ACRRR)#2
DO ^ACRFRR31
+9 IF $DATA(ACRIV)#2
DO ^ACRFIV31
+10 QUIT
