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

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PRCHREC2 ;ID/RSD,SF/TKW-CONT. OF RECEIVING ;1/25/93 13:17
2V ;;5.1;IFCAP;**81**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5TM 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)
6 S:$O(I(0)) PRCHRT0=I($O(I(0))),PRCHRT=+PRCHRT0/100,PRCHRT0=$P(PRCHRT0,U,1)_"%"_$P(PRCHRT0,U,2)
7 I $P(^PRC(442,PRCHPO,0),U,19)=2 S PRCHRT=0
8 Q
9 ;
10MULT S I=1 F Y=Y+.12:.01 Q:'$D(^PRC(442,PRCHPO,2,"AB",Y)) S I=I+1
11 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
12 Q
13 ;
14WP 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))
15 F I=0:0 S I=$O(^UTILITY($J,"W",DIWL,I)) Q:'I W !?5,^(I,0)
16 K PRCHI,DIWL,DIWR,DIWF,^UTILITY($J,"W")
17 Q
18 ;
19DEL S %A=" Are you sure you want to delete this Receiving Report ",%B="",%=2 D ^PRCFYN I %'=1 G:'$D(PRCHRDEL) ES Q
20 ;
21 ; PRC*5.1*81 - if site runs DynaMed, may need to build update txn
22 I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")=1 D REC^PRCV442A(PRCHPO,PRCHRPT,2)
23 ;
24DELP D WAIT^DICD K ^PRC(442,PRCHPO,11,PRCHRPT) S $P(^(0),U,3,4)="0^"_($P(^(0),U,4)-1)
25 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
26 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)=""
27 W !!?5,"Receiving Report Deleted ",$C(7) K PRCHRD,PRCHRPT,PRCHRI,PRCHRIT,DIK,DA G:'$D(PRCHRDEL) Q^PRCHREC
28 Q
29 ;
30DEL1 S DIK="^PRC(442,PRCHPO,2,+PRCHRIT,3,",DA=PRCHRDY,DA(1)=+PRCHRIT,DA(2)=PRCHPO D ^DIK K DIK W " <DELETED> ",$C(7),!
31 Q
32 ;
33SUB S PRCHRIT=$O(^PRC(442,PRCHPO,2,"AB",PRCHRD,+PRCHRIT)) Q:'PRCHRIT S PRCHRI=+$O(^(PRCHRIT,0))
34 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
35 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:"**")
36 I $P(^PRC(442,PRCHPO,0),U,6)="" S PRCHRS="**"
37 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
38 S PRCHR("SA",PRCHRS)=PRCHR("SA",PRCHRS)+PRCHRAM-PRCHRDA,^PRC(442,PRCHPO,2,+PRCHRIT,3,"AC",PRCHRPT,PRCHRI)=""
39 I 'PRCHRFIN K:PRCHRQ1'>PRCHRQ2 ^PRC(442,PRCHPO,2,"C",$P(PRCHRIT,U,2))
40 G SUB
41 ;
42ES 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
43 N RRCHK S RRCHK=$P($G(^PRC(411,PRC("SITE"),0)),"^",8)
44 N MOPCHK S MOPCHK=$P($G(^PRC(442,PRCHPO,0)),"^",2) S:MOPCHK=25 RRCHK="N"
45 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
46 I '$D(PRCHPOO) D ^PRCFYN G:%'=1&($D(PRCHIMP)) DEL G:%'=1 ED
47 S DA=PRCHPO,P=+PRC("PER") I $D(PRCHPOO) S X=$P(PRC("PER"),"^",2),PRCHNM=X G EN3^PRCHREC
48 S PRCSIG="" D ESIG^PRCUESIG(+DUZ,.PRCSIG) S ROUTINE="PRCUESIG" G:PRCSIG'=1 QQ
49 G EN3^PRCHREC
50 ;
51ED S %A=" Edit this receiving report ",%B="",%=1 D ^PRCFYN G:%'=1 DEL
52 D ENTD^PRCHREC4 G:PRCHDLVD["^" DEL
53 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)=""
54 K PRCHR,^PRC(442,PRCHPO,11,PRCHRPT) S $P(^(0),U,3,4)="0^"_($P(^(0),U,4)-1) W !
55 G LI^PRCHREC1
56 ;
57QQ 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
58 G DEL
Note: See TracBrowser for help on using the repository browser.