source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHREC2.m@ 1806

PRCHREC2 ;ID/RSD,SF/TKW-CONT. OF RECEIVING ;1/25/93  13:17
V ;;5.1;IFCAP;**81**;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
TM K I F I=0:0 S I=$O(^PRC(442,PRCHPO,5,I)) Q:'I  I +^(I,0)>0 S I(100-^(0))=^(0)
 S:$O(I(0)) PRCHRT0=I($O(I(0))),PRCHRT=+PRCHRT0/100,PRCHRT0=$P(PRCHRT0,U,1)_"%"_$P(PRCHRT0,U,2)
 I $P(^PRC(442,PRCHPO,0),U,19)=2 S PRCHRT=0
 Q
 ;
MULT S I=1 F Y=Y+.12:.01 Q:'$D(^PRC(442,PRCHPO,2,"AB",Y))  S I=I+1
 W !?3,I," receiving report(s) for ",X," already exist.",$C(7) S %A="     Do you want to continue ",%B="",%=2 D ^PRCFYN K:%'=1 X,Y
 Q
 ;
WP Q:'$D(^PRC(442,PRCHPO,2,+PRCHRIT,1,0))  K ^UTILITY($J,"W") S DIWL=1,DIWR=65,DIWF="" F PRCHI=0:0 S PRCHI=$O(^PRC(442,PRCHPO,2,+PRCHRIT,1,PRCHI)) Q:'PRCHI  S X=^(PRCHI,0) N Y D DIWP^PRCUTL($G(DA))
 F I=0:0 S I=$O(^UTILITY($J,"W",DIWL,I)) Q:'I  W !?5,^(I,0)
 K PRCHI,DIWL,DIWR,DIWF,^UTILITY($J,"W")
 Q
 ;
DEL S %A="   Are you sure you want to delete this Receiving Report ",%B="",%=2 D ^PRCFYN I %'=1 G:'$D(PRCHRDEL) ES Q
 ;
 ; PRC*5.1*81 - if site runs DynaMed, may need to build update txn
 I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")=1 D REC^PRCV442A(PRCHPO,PRCHRPT,2)
 ;
DELP D WAIT^DICD K ^PRC(442,PRCHPO,11,PRCHRPT) S $P(^(0),U,3,4)="0^"_($P(^(0),U,4)-1)
 F PRCHRIT=0:0 S PRCHRIT=$O(^PRC(442,PRCHPO,2,"AB",PRCHRD,PRCHRIT)) Q:'PRCHRIT  S PRCHRI=$O(^(PRCHRIT,0)),DA=PRCHRI,DA(1)=PRCHRIT,DA(2)=PRCHPO,DIK="^PRC(442,PRCHPO,2,PRCHRIT,3," D ^DIK
 F PRCHRIT=0:0 S PRCHRIT=$O(^PRC(442,PRCHPO,2,PRCHRIT)) Q:'PRCHRIT  I $D(^(PRCHRIT,0)) S X=+^(0),Y=$P(^(0),"^",2),Z=0 S:$D(^(2)) Z=$P(^(2),"^",8) I Z<Y S ^PRC(442,PRCHPO,2,"C",X,PRCHRIT)=""
 W !!?5,"Receiving Report Deleted ",$C(7) K PRCHRD,PRCHRPT,PRCHRI,PRCHRIT,DIK,DA G:'$D(PRCHRDEL) Q^PRCHREC
 Q
 ;
DEL1 S DIK="^PRC(442,PRCHPO,2,+PRCHRIT,3,",DA=PRCHRDY,DA(1)=+PRCHRIT,DA(2)=PRCHPO D ^DIK K DIK W "   <DELETED> ",$C(7),!
 Q
 ;
SUB S PRCHRIT=$O(^PRC(442,PRCHPO,2,"AB",PRCHRD,+PRCHRIT)) Q:'PRCHRIT  S PRCHRI=+$O(^(PRCHRIT,0))
 G:'$D(^PRC(442,PRCHPO,2,PRCHRIT,3,PRCHRI,0)) SUB S Y=^(0),PRCHRAM=$P(Y,U,3),PRCHRDA=$P(Y,U,5),$P(Y,U,4)=PRCHRPT,^(0)=Y,PRCHLC=PRCHLC+1
 I $P(^PRC(442,PRCHPO,0),U,6)]"" S PRCHRS=$S($P(^PRC(442,PRCHPO,2,PRCHRIT,2),U,7)]"":$P(^(2),U,7),1:"**")
 I $P(^PRC(442,PRCHPO,0),U,6)="" S PRCHRS="**"
 S PRCHRQ1=$P(^PRC(442,PRCHPO,2,PRCHRIT,0),U,2),PRCHRIT=PRCHRIT_U_$P(^(0),U,1),PRCHRQ2=$P(^(2),U,8) S:'$D(PRCHR("SA",PRCHRS)) PRCHR("SA",PRCHRS)=0
 S PRCHR("SA",PRCHRS)=PRCHR("SA",PRCHRS)+PRCHRAM-PRCHRDA,^PRC(442,PRCHPO,2,+PRCHRIT,3,"AC",PRCHRPT,PRCHRI)=""
 I 'PRCHRFIN K:PRCHRQ1'>PRCHRQ2 ^PRC(442,PRCHPO,2,"C",$P(PRCHRIT,U,2))
 G SUB
 ;
ES W ! I $G(PRCHRFIN) W $C(7) S %A="Is this Receiving Report the FINAL for this ESTIMATED Purchase Order ",%B="",%=2,PRCHRFIN=0 D ^PRCFYN S:%=1 PRCHRFIN=1
 N RRCHK S RRCHK=$P($G(^PRC(411,PRC("SITE"),0)),"^",8)
 N MOPCHK S MOPCHK=$P($G(^PRC(442,PRCHPO,0)),"^",2) S:MOPCHK=25 RRCHK="N"
 I '$D(PRCHPOO) S %A="   Approve this receiving report "_$S($D(PRCHIMP):"and complete the P.O.",((RRCHK="Y")&('$P($G(^PRC(442,PRCHPO,24)),U))):"and print in Receiving ",1:""),%B="",%=1
 I '$D(PRCHPOO) D ^PRCFYN G:%'=1&($D(PRCHIMP)) DEL G:%'=1 ED
 S DA=PRCHPO,P=+PRC("PER") I $D(PRCHPOO) S X=$P(PRC("PER"),"^",2),PRCHNM=X G EN3^PRCHREC
 S PRCSIG="" D ESIG^PRCUESIG(+DUZ,.PRCSIG) S ROUTINE="PRCUESIG" G:PRCSIG'=1 QQ
 G EN3^PRCHREC
 ;
ED S %A="   Edit this receiving report ",%B="",%=1 D ^PRCFYN G:%'=1 DEL
 D ENTD^PRCHREC4 G:PRCHDLVD["^" DEL
 F I=0:0 S I=$O(^PRC(442,PRCHPO,2,"AB",PRCHRD,I)) Q:'I  I $D(^PRC(442,PRCHPO,2,I,0)) S ^PRC(442,PRCHPO,2,"C",+^(0),I)=""
 K PRCHR,^PRC(442,PRCHPO,11,PRCHRPT) S $P(^(0),U,3,4)="0^"_($P(^(0),U,4)-1) W !
 G LI^PRCHREC1
 ;
QQ S:'$D(ROUTINE) ROUTINE=$T(+0) W !!,$$ERR^PRCHQQ(ROUTINE,PRCSIG) W:PRCSIG=0!(PRCSIG=-3) !,"Notify Application Coordinator!",$C(7) S DIR(0)="EAO",DIR("A")="Press <return> to continue" D ^DIR K ROUTINE
 G DEL