ACRFRR31 ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORTS CONTINUED; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;CONTINUATION OF ACRFRR
RECEIVE ;EP;
D TOTRCD1
I ACRRCDX'<ACRRQD D Q:ACRACPX'<ACRRQD
.W !!,ACRRQD," of these items ",$S(ACRRQD=1:"was",1:"were")," ordered,"
.W !,ACRRCDX,$S(ACRRCDX=1:" has",1:" have")," already been received and."
.W !,ACRACPX,$S(ACRACPX=1:" has",1:" have")," already been accepted."
.W:ACRACPX'<ACRRQD !,"No further receiving action should be taken for this item."
.D PAUSE^ACRFWARN
;S DIR(0)="FOA^1:10:I X?1N.6N.""."".N"
S DIR(0)="NOA^0:"_(ACRRQD-ACRACP)_":3"
S DIR("A")="NUMBER RECEIVED.....: "
S DIR("?")="Enter the actual number received"
S DIR("B")=ACRUNRCD
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) D INCOMPLT Q
S ACRRCDX=Y
S ACRRCD=ACRRCD+Y
S DIR(0)="FOA^1:10^I X?1N.6N.""."".N"
S DIR("A")="NUMBER ACCEPTED.....: "
S DIR("?")="Enter the actual number accepted"
S DIR("B")=ACRRCDX
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) D INCOMPLT Q
S ACRACPX=Y
S ACRACP=ACRACP+Y
D DATE
D ADD:'$D(ACRQUIT)
Q
ADD ;EP;ADD RECEIVING REPORT
;
N ACRNOW
D NOW^%DTC
S ACRNOW=%
S X=ACRSSDA
S DIC="^ACRRR("
S DIC(0)="L"
S DIC("DR")=".02////"_ACRSSPO_";.03////"_ACRSSRQ_";.04////"_ACRRRNO_";.05////"_DUZ_";.06////"_ACRNOW_";2////"_ACRRCDX_";3////"_ACRACPX_";4////"_ACRDATE
D FILE^ACRFDIC
I Y<1 S ACRQUIT="" Q
S ACRRRDA=+Y
S X=ACRNOW
S DA(1)=ACRRRDA
S DIC="^ACRRR("_ACRRRDA_",11,"
S DIC(0)="L"
S DIC("DR")=".02////"_DUZ_";.03////1"
S:'$D(@(DIC_"0)")) ^ACRRR(ACRRRDA,11,0)="^9002193.2111D"
D FILE^ACRFDIC
C1 ;EP
D TOTAL
S DA=ACRSSDA
S DIE="^ACRSS("
S DR=$S($D(ACRRR)#2:"14////"_ACRRCD_";15////"_ACRACP,1:"16////"_(ACRIVD*ACRUC)_";17////"_ACRIVD)
S ACROBJ=$P(^ACRSS(ACRSSDA,0),U,4)
I ACROBJ,$D(^AUTTOBJC(ACROBJ,0)) D
.S ACROBJ=$P(^AUTTOBJC(ACROBJ,0),U)
.S:$E(ACROBJ,1,2)=26 DR=DR_";33T"
D DIE^ACRFDIC
I ACRACP<ACRRCD D
.S DA=ACRSSDA
.S DIE="^ACRSS("
.S DR="[ACR REJECTION/CANCELLATION]"
.D DIE^ACRFDIC
Q
INCOMPLT ;
W *7,*7
W !!,"Data entry for ITEM NO. ",ACRJ," not completed, entry not accepted."
D PAUSE^ACRFWARN
Q
TOTAL S (X,ACRRCD,ACRACP)=0
F S X=$O(^ACRRR("B",ACRSSDA,X)) Q:'X D
.S ACRRRDT=$G(^ACRRR(X,"DT"))
.S ACRRCD=ACRRCD+$P(ACRRRDT,U,2)
.S ACRACP=ACRACP+$P(ACRRRDT,U,3)
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 REC'D ON A
;RECEIVING ACTION DOES NOT MAKE THE TOTAL QUANTITY REC'D GREATER THAN
;TOTAL QUANTITY ORDERED
D TOTRCD
S:$D(^ACRRR(DA,"DT")) ACRRCDX=ACRRCDX-$P(^("DT"),U,2)
I ACRRCDX+X>ACRRQD 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
TOTRCD ;EP;TO CALCULATE THE TOTAL RECEIVED FOR AN ITEM
S ACRRCDX=0
I '$D(ACRRRDA),'$D(DA) D TOTRCD1 Q
I '$D(DA),$D(ACRRRDA) S DA=ACRRRDA
N ACRRRDA,ACRSSDA
S ACRRRDA=DA
Q:'$D(^ACRRR(+DA,0))
S ACRSSDA=+^ACRRR(DA,0)
TOTRCD1 Q:'$D(^ACRSS(ACRSSDA,"DT"))
S ACRRQD=+^ACRSS(ACRSSDA,"DT")
S (ACRRCDX,ACRRRX,ACRACPX)=0
F S ACRRRX=$O(^ACRRR("B",ACRSSDA,ACRRRX)) Q:'ACRRRX D
.S ACRRCDX=ACRRCDX+$P($G(^ACRRR(ACRRRX,"DT")),U,2)
.S ACRACPX=ACRACPX+$P($G(^ACRRR(ACRRRX,"DT")),U,3)
K ACRRRX
Q
DATE ;EP;
S DIR(0)="DA^::EP"
S DIR("A")="DATE RECEIVED.......: "
S DIR("?",1)="Enter the date the items were actually received,"
S DIR("?")="not the date you are doing the Receiving Report."
I $G(ACRDATE) D
.S Y=$P(ACRDATE,".")
.X ^DD("DD")
.S DIR("B")=Y
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT),$D(ACRJ),ACRJ D INCOMPLT Q
S ACRDATE=Y
Q
ACRFRR31 ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORTS CONTINUED; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFRR
RECEIVE ;EP;
+1 DO TOTRCD1
+2 IF ACRRCDX'<ACRRQD
Begin DoDot:1
+3 WRITE !!,ACRRQD," of these items ",$SELECT(ACRRQD=1:"was",1:"were")," ordered,"
+4 WRITE !,ACRRCDX,$SELECT(ACRRCDX=1:" has",1:" have")," already been received and."
+5 WRITE !,ACRACPX,$SELECT(ACRACPX=1:" has",1:" have")," already been accepted."
+6 IF ACRACPX'<ACRRQD
WRITE !,"No further receiving action should be taken for this item."
+7 DO PAUSE^ACRFWARN
End DoDot:1
IF ACRACPX'<ACRRQD
QUIT
+8 ;S DIR(0)="FOA^1:10:I X?1N.6N.""."".N"
+9 SET DIR(0)="NOA^0:"_(ACRRQD-ACRACP)_":3"
+10 SET DIR("A")="NUMBER RECEIVED.....: "
+11 SET DIR("?")="Enter the actual number received"
+12 SET DIR("B")=ACRUNRCD
+13 DO DIR^ACRFDIC
+14 IF $DATA(ACRQUIT)!$DATA(ACROUT)
DO INCOMPLT
QUIT
+15 SET ACRRCDX=Y
+16 SET ACRRCD=ACRRCD+Y
+17 SET DIR(0)="FOA^1:10^I X?1N.6N.""."".N"
+18 SET DIR("A")="NUMBER ACCEPTED.....: "
+19 SET DIR("?")="Enter the actual number accepted"
+20 SET DIR("B")=ACRRCDX
+21 DO DIR^ACRFDIC
+22 IF $DATA(ACRQUIT)!$DATA(ACROUT)
DO INCOMPLT
QUIT
+23 SET ACRACPX=Y
+24 SET ACRACP=ACRACP+Y
+25 DO DATE
+26 IF '$DATA(ACRQUIT)
DO ADD
+27 QUIT
ADD ;EP;ADD RECEIVING REPORT
+1 ;
+2 NEW ACRNOW
+3 DO NOW^%DTC
+4 SET ACRNOW=%
+5 SET X=ACRSSDA
+6 SET DIC="^ACRRR("
+7 SET DIC(0)="L"
+8 SET DIC("DR")=".02////"_ACRSSPO_";.03////"_ACRSSRQ_";.04////"_ACRRRNO_";.05////"_DUZ_";.06////"_ACRNOW_";2////"_ACRRCDX_";3////"_ACRACPX_";4////"_ACRDATE
+9 DO FILE^ACRFDIC
+10 IF Y<1
SET ACRQUIT=""
QUIT
+11 SET ACRRRDA=+Y
+12 SET X=ACRNOW
+13 SET DA(1)=ACRRRDA
+14 SET DIC="^ACRRR("_ACRRRDA_",11,"
+15 SET DIC(0)="L"
+16 SET DIC("DR")=".02////"_DUZ_";.03////1"
+17 IF '$DATA(@(DIC_"0)"))
SET ^ACRRR(ACRRRDA,11,0)="^9002193.2111D"
+18 DO FILE^ACRFDIC
C1 ;EP
+1 DO TOTAL
+2 SET DA=ACRSSDA
+3 SET DIE="^ACRSS("
+4 SET DR=$SELECT($DATA(ACRRR)#2:"14////"_ACRRCD_";15////"_ACRACP,1:"16////"_(ACRIVD*ACRUC)_";17////"_ACRIVD)
+5 SET ACROBJ=$PIECE(^ACRSS(ACRSSDA,0),U,4)
+6 IF ACROBJ
IF $DATA(^AUTTOBJC(ACROBJ,0))
Begin DoDot:1
+7 SET ACROBJ=$PIECE(^AUTTOBJC(ACROBJ,0),U)
+8 IF $EXTRACT(ACROBJ,1,2)=26
SET DR=DR_";33T"
End DoDot:1
+9 DO DIE^ACRFDIC
+10 IF ACRACP<ACRRCD
Begin DoDot:1
+11 SET DA=ACRSSDA
+12 SET DIE="^ACRSS("
+13 SET DR="[ACR REJECTION/CANCELLATION]"
+14 DO DIE^ACRFDIC
End DoDot:1
+15 QUIT
INCOMPLT ;
+1 WRITE *7,*7
+2 WRITE !!,"Data entry for ITEM NO. ",ACRJ," not completed, entry not accepted."
+3 DO PAUSE^ACRFWARN
+4 QUIT
TOTAL SET (X,ACRRCD,ACRACP)=0
+1 FOR
SET X=$ORDER(^ACRRR("B",ACRSSDA,X))
IF 'X
QUIT
Begin DoDot:1
+2 SET ACRRRDT=$GET(^ACRRR(X,"DT"))
+3 SET ACRRCD=ACRRCD+$PIECE(ACRRRDT,U,2)
+4 SET ACRACP=ACRACP+$PIECE(ACRRRDT,U,3)
End DoDot:1
+5 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 REC'D ON A
+1 ;RECEIVING ACTION DOES NOT MAKE THE TOTAL QUANTITY REC'D GREATER THAN
+2 ;TOTAL QUANTITY ORDERED
+3 DO TOTRCD
+4 IF $DATA(^ACRRR(DA,"DT"))
SET ACRRCDX=ACRRCDX-$PIECE(^("DT"),U,2)
+5 IF ACRRCDX+X>ACRRQD
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
TOTRCD ;EP;TO CALCULATE THE TOTAL RECEIVED FOR AN ITEM
+1 SET ACRRCDX=0
+2 IF '$DATA(ACRRRDA)
IF '$DATA(DA)
DO TOTRCD1
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
+7 SET ACRSSDA=+^ACRRR(DA,0)
TOTRCD1 IF '$DATA(^ACRSS(ACRSSDA,"DT"))
QUIT
+1 SET ACRRQD=+^ACRSS(ACRSSDA,"DT")
+2 SET (ACRRCDX,ACRRRX,ACRACPX)=0
+3 FOR
SET ACRRRX=$ORDER(^ACRRR("B",ACRSSDA,ACRRRX))
IF 'ACRRRX
QUIT
Begin DoDot:1
+4 SET ACRRCDX=ACRRCDX+$PIECE($GET(^ACRRR(ACRRRX,"DT")),U,2)
+5 SET ACRACPX=ACRACPX+$PIECE($GET(^ACRRR(ACRRRX,"DT")),U,3)
End DoDot:1
+6 KILL ACRRRX
+7 QUIT
DATE ;EP;
+1 SET DIR(0)="DA^::EP"
+2 SET DIR("A")="DATE RECEIVED.......: "
+3 SET DIR("?",1)="Enter the date the items were actually received,"
+4 SET DIR("?")="not the date you are doing the Receiving Report."
+5 IF $GET(ACRDATE)
Begin DoDot:1
+6 SET Y=$PIECE(ACRDATE,".")
+7 XECUTE ^DD("DD")
+8 SET DIR("B")=Y
End DoDot:1
+9 DO DIR^ACRFDIC
+10 IF $DATA(ACRQUIT)!$DATA(ACROUT)
IF $DATA(ACRJ)
IF ACRJ
DO INCOMPLT
QUIT
+11 SET ACRDATE=Y
+12 QUIT
