PRCHAMU1 ;WISC/DJM-Reprint amendment ;3/1/95 1:22 PM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
GETPO ;get a valid PO
;the variable RETURN is either the PO/REQ# or null if no PO is selected
N DIC,D,Y,X,PRCAM,PRCHQ,D0,D1
S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))
S DIC="^PRC(443.6,",DIC(0)="QEAMZ"
S DIC("A")=$S($D(PRCHREQ):"REQUISITION NO.: ",1:"PURCHASE ORDER: ")
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"
D ^DIC K DIC Q:Y<0
S PRCHPO=+Y
S (PRCAM,PRCHAM)=0
F S PRCAM=$O(^PRC(443.6,+Y,6,PRCAM)) Q:PRCAM'>0 S PRCHAM=PRCAM
D ^PRCHSF3
W !,"QUEUED TO SUPPLY PRINTER"
S PRCHQ="^PRCHPAM8",D0=PRCHPO,D1=PRCHAM,PRCHQ("DEST")="S8"
D ^PRCHQUE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHAMU1 817 printed Dec 13, 2024@02:05:45 Page 2
PRCHAMU1 ;WISC/DJM-Reprint amendment ;3/1/95 1:22 PM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
GETPO ;get a valid PO
+1 ;the variable RETURN is either the PO/REQ# or null if no PO is selected
+2 NEW DIC,D,Y,X,PRCAM,PRCHQ,D0,D1
+3 SET PRCF("X")="S"
DO ^PRCFSITE
if '$DATA(PRC("SITE"))
QUIT
+4 SET DIC="^PRC(443.6,"
SET DIC(0)="QEAMZ"
+5 SET DIC("A")=$SELECT($DATA(PRCHREQ):"REQUISITION NO.: ",1:"PURCHASE ORDER: ")
+6 SET DIC("S")="I +$P(^(0),U)=PRC(""SITE"")"_$SELECT($DATA(PRCHREQ):",$P(^(0),U,2)=8",1:",$P(^(0),U,2)<8")_",$D(^(6))>9,$P($G(^(6,0)),U,4)>0"
+7 DO ^DIC
KILL DIC
if Y<0
QUIT
+8 SET PRCHPO=+Y
+9 SET (PRCAM,PRCHAM)=0
+10 FOR
SET PRCAM=$ORDER(^PRC(443.6,+Y,6,PRCAM))
if PRCAM'>0
QUIT
SET PRCHAM=PRCAM
+11 DO ^PRCHSF3
+12 WRITE !,"QUEUED TO SUPPLY PRINTER"
+13 SET PRCHQ="^PRCHPAM8"
SET D0=PRCHPO
SET D1=PRCHAM
SET PRCHQ("DEST")="S8"
+14 DO ^PRCHQUE
+15 QUIT
