source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHAMU1.m@ 1710

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

initial load of WorldVistAEHR

File size: 798 bytes
RevLine 
[613]1PRCHAMU1 ;WISC/DJM-Reprint amendment ;3/1/95 1:22 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4GETPO ;get a valid PO
5 ;the variable RETURN is either the PO/REQ# or null if no PO is selected
6 N DIC,D,Y,X,PRCAM,PRCHQ,D0,D1
7 S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))
8 S DIC="^PRC(443.6,",DIC(0)="QEAMZ"
9 S DIC("A")=$S($D(PRCHREQ):"REQUISITION NO.: ",1:"PURCHASE ORDER: ")
10 S DIC("S")="I +$P(^(0),U)=PRC(""SITE"")"_$S($D(PRCHREQ):",$P(^(0),U,2)=8",1:",$P(^(0),U,2)<8")_",$D(^(6))>9,$P($G(^(6,0)),U,4)>0"
11 D ^DIC K DIC Q:Y<0
12 S PRCHPO=+Y
13 S (PRCAM,PRCHAM)=0
14 F S PRCAM=$O(^PRC(443.6,+Y,6,PRCAM)) Q:PRCAM'>0 S PRCHAM=PRCAM
15 D ^PRCHSF3
16 W !,"QUEUED TO SUPPLY PRINTER"
17 S PRCHQ="^PRCHPAM8",D0=PRCHPO,D1=PRCHAM,PRCHQ("DEST")="S8"
18 D ^PRCHQUE
19 Q
Note: See TracBrowser for help on using the repository browser.