| [613] | 1 | PRCHAMU1 ;WISC/DJM-Reprint amendment ;3/1/95 1:22 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | GETPO ;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
|
|---|
