PRCHQ2B ;(WASH IRMFO)/LKG-RFQ Enter/Edit cont ;9/8/96 21:07
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
I $P(PRC410(3),U,4)]"" D
. S ^PRC(444,PRCDA,5,0)="^"_$P(^DD(444,20,0),U,2)_"^1^1"
. S ^PRC(444,PRCDA,5,1,0)=$P(PRC410(3),U,4)_";PRC(440,"
I $P(PRC410(3),U,4)="" D
. N DIC,DIE,DR,Y,DA
. S DIC=444.1,DIC(0)="XL",DLAYGO=444.1,X=$P(PRC410(2),U) D ^DIC K DLAYGO
. Q:+Y<1
. S ^PRC(444,PRCDA,5,0)="^"_$P(^DD(444,20,0),U,2)_"^1^1"
. S ^PRC(444,PRCDA,5,1,0)=+Y_";PRC(444.1,"
. I $P(Y,U,3) D
. . S DA=+Y,DIE=444.1 L +^PRC(444.1,DA):5 E W !,"Vendor ",$P(PRC410(2),U)," is being edited by another user." Q
. . S PRCX=$P(PRC410(2),U,2) I PRCX]"" S DR="1///^S X=PRCX" D ^DIE
. . S PRCX=$P(PRC410(2),U,3) I PRCX]"" S DR="2///^S X=PRCX" D ^DIE
. . S PRCX=$P(PRC410(2),U,4) I PRCX]"" S DR="3///^S X=PRCX" D ^DIE
. . S PRCX=$P(PRC410(2),U,5) I PRCX]"" S DR="4///^S X=PRCX" D ^DIE
. . S PRCX=$P(PRC410(2),U,6) I PRCX]"" S DR="4.2///^S X=PRCX" D ^DIE
. . S PRCX=$P(PRC410(2),U,7) I PRCX]"" S DR="4.4////^S X=PRCX" D ^DIE
. . S PRCX=$P(PRC410(2),U,8) I PRCX]"" S DR="4.6///^S X=PRCX" D ^DIE
. . S PRCX=$P(PRC410(2),U,9) I PRCX]"" S DR="4.8///^S X=PRCX" D ^DIE
. . S PRCX=$P(PRC410(2),U,10) I PRCX]"" S DR="5///^S X=PRCX" D ^DIE
. . L -^PRC(444.1,DA)
S DA=PRCDA410,DIE="^PRC(443,",DR="1.5////79" D ^DIE K DA,DIE,DR
L:$D(PRCDA410) -(^PRCS(410,PRCDA410),^PRC(443,PRCDA410))
K DA,I,PRCDA410,PRC410,PRC443,PRCE,PRCI,PRCJ,PRCK,PRCL,PRCM,PRCN,PRCP,PRCQ,PRCX,PRCY,X,Y
K DIR S DIR(0)="YA",DIR("A")="Do you wish to import items from an additional 2237? "
S DIR("B")="NO"
S DIR("?",1)="If you answer 'YES', you will be prompted for an Assigned to Purchasing Agent"
S DIR("?",2)="2237 with the same Fund Control Point."
S DIR("?")="All item information on that 2237 will be imported into this RFQ"
D ^DIR K DIR G INDX:$D(DIRUT),INDX:Y'=1
S PRCX=$P($P(^PRC(444,PRCDA,0),U,14)," ")
LOOP K DIC S DIC="^PRC(443,",DIC(0)="AEMN"
S DIC("S")="I "";70;80;""[("";""_$P(^(0),U,7)_"";""),PRCX=$P($P($G(^PRCS(410,Y,0)),U),""-"",4),$P($G(^PRCS(410,Y,4)),U,5)="""""
S DIC("A")="Enter additional 2237 Transaction #: " D ^DIC K DIC
I Y<1!$D(DTOUT)!$D(DUOUT) G INDX
S PRCDA410=+Y
L +^PRC(443,PRCDA410):5 E W !,"Work Sheet entry in use, please try later!" G INDX
L +^PRCS(410,PRCDA410):5 E W !,"Someone is editing the source 2237, please try later!" G INDX
W !,"Importing item information into this RFQ entry..."
S PRC410(3)=$G(^PRCS(410,PRCDA410,3))
D IT^PRCHQ2A
S DA=PRCDA410,DIE="^PRC(443,",DR="1.5////79" D ^DIE K DA,DIE,DR
L -(^PRCS(410,PRCDA410),^PRC(443,PRCDA410))
K PRCDA410
G LOOP
INDX ;Index the entry
K PRC410
D NOW^%DTC S $P(^PRC(444,PRCDA,1),U,9,10)=DUZ_U_% K %,%H,%I
W !,"Building the cross references..."
S DIK="^PRC(444,",DA=PRCDA D IX1^DIK K DA,DIK
G:$D(DUOUT)!$D(DIRUT)!$D(DTOUT) OUT
CONT D EDIT L -^PRC(444,PRCDA)
I '$D(DTOUT)&'$D(DUOUT)&'$D(DIRUT)&'$D(DIROUT) G B^PRCHQ2:$G(PRCNEW),A^PRCHQ2
OUT ;
L:$D(PRCDA410) -(^PRCS(410,PRCDA410),^PRC(443,PRCDA410))
L:$D(PRCDA) -^PRC(444,PRCDA)
K DA,DIC,DIRUT,DIROUT,DTOUT,DUOUT,PRCDA,PRCDA410,PRCOUT,PRCX,X,Y,PRCNEW,PRCEDIT
Q
EDIT ;Edit RFQ
N %,%H,%I
I PRCEDIT="s" D
. K DA S DDSPARM="CS"
. S DDSFILE=444,DR="[PRCHQ1]",DA=PRCDA,DDSPAGE=1 D ^DDS
. K DA,DDSFILE,DR,DDSPAGE,DDSPARM,DIMSG,PRCMSG,%
I PRCEDIT="i" D
. N PRCMSG,PRCI,PRCX,PRCRD,PRCRQD,PRCDA2,PRCITMO,PRCIEN,PRCVEN
. S PRCMSG="" D ESIG^PRCUESIG(DUZ,.PRCMSG)
. I PRCMSG'=1 D EN^DDIOL("Electronic Signature Failed, Edit aborted") S PRCERR=10 Q
. K DA S DIE="^PRC(444,",DA=PRCDA,DR="[PRCHQ RFQ REQUEST]" D ^DIE K DIE,DR
. D NOW^%DTC S $P(^PRC(444,PRCDA,1),U,9,10)=DUZ_U_%
. I $D(DTOUT) S PRCERR=10 Q
. I $D(DUOUT) K DIR S DIR(0)="YA",DIR("A")="Do you wish to continue? ",DIR("B")="NO" D ^DIR K DIR I Y'=1 S PRCERR=10 Q
. K DUOUT
. S PRCI=0
. F S PRCI=$O(^PRC(444,PRCDA,5,PRCI)) Q:+PRCI'=PRCI D Q:$G(PRCERR)
. . S PRCX=$G(^PRC(444,PRCDA,5,PRCI,0)) Q:$P(PRCX,U)'["PRC(444.1,"
. . W !!,"Editing Solicited Vendor in RFQ Temporary Vendor File..."
. . L +^PRC(444.1,+PRCX):3 E S X="Vendor "_$P($G(^PRC(444.1,+PRCX,0)),U)_" is locked, please try later!" D EN^DDIOL(X) Q
. . K DA S DA=+PRCX,DIE="^PRC(444.1,",DR=".01;18.3;38;4.8;5;46;1R;2;3;4;4.2R;4.4R;4.6"
. . D ^DIE K DIE,DR,DA L -^PRC(444.1,+PRCX)
. . I $D(DTOUT) S PRCERR=10 Q
. . I $D(DUOUT) K DIR S DIR(0)="YA",DIR("A")="Do you wish to continue? ",DIR("B")="NO" D ^DIR K DIR I Y'=1 S PRCERR=10 Q
. . K DUOUT
. K DIR S DIR(0)="YA",DIR("A")="Do you wish to view the RFQ? "
. S DIR("B")="YES" D ^DIR K DIR I $D(DIROUT)!$D(DIRUT) S PRCERR=10 Q
. I Y=1 D
. . S PRCRFQ=$P($G(^PRC(444,PRCDA,0)),U)
. . S DIC=444,BY=.01,FLDS="[PRCHQ RFQ FULL]",L=0,(FR,TO)=PRCRFQ,DHD="@"
. . D EN1^DIP K BY,DIC,DHD,FLDS,FR,L,TO
I $G(DDSCHANG)=1!($G(DDSSAVE)=1)!(PRCEDIT="i"&'$G(PRCERR)) D
. N PRCRFQ,PRCTYPE,PRCNOPRT S PRCRFQ=$P(^PRC(444,PRCDA,0),U)
. K DIR S DIR(0)="YA",DIR("A")="Do you wish to transmit this RFQ to vendors? "
. S DIR("B")="YES",DIR("?")="Accept default of 'YES' to transmit, enter 'NO' to avoid transmitting."
. D ^DIR K DIR Q:Y'=1!$D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
. I $P($G(^PRC(444,PRCDA,1)),U,8)'="y",$P($G(^PRC(444,PRCDA,5,0)),U,4)'>0 D EN^DDIOL("Warning - Transmit aborted as there are NO RECIPIENTS!") Q
. S PRCTYPE="00"
. K PRCERR
. D TRANS840^PRCHQ4A(PRCTYPE)
. I $G(PRCERR) D EN^DDIOL("Due to Error Conditions Transmission Was Aborted!") Q
. S PRCNOPRT=$$MANUAL
. I $P($G(^PRC(444,PRCDA,1)),U,11)=""&PRCNOPRT D EN^DDIOL("RFQ has not been transmitted, use option Edit Incomplete RFQ to complete.") Q
. D:PRCNOPRT EN^DDIOL("Required manual RFQs were not printed, use option Manual Print of RFQ.")
. I $P($G(^PRC(444,PRCDA,1)),U,11)]""!('PRCNOPRT) D
. . N PRCAR,PRCSTAT,PRCSTRG
. . S PRCSTRG="CANCELLED^INCOMPLETE^PENDING QUOTES^CLOSED^EVALUATION COMPLETE^AWARDED",PRCSTAT=$P(PRCSTRG,U,$P(^PRC(444,PRCDA,0),U,8)+1)
. . K DA S DA=PRCDA,DR="7////2",DIE="^PRC(444," D ^DIE K DA,DIE,DR
. . S PRCAR(1)="The status of RFQ #: "_PRCRFQ_" has been changed from"
. . S PRCAR(2)=" '"_PRCSTAT_"' to '"_$P(PRCSTRG,U,$P($G(^PRC(444,PRCDA,0)),U,8)+1)_"'."
. . D EN^DDIOL(.PRCAR)
K DDSCHANG,DDSSAVE,PRCERR
Q
MANUAL() ;Print Manual RFQ
N X,Y,POP,%,%H,%I,DA
S X=0,Y=0
F S X=$O(^PRC(444,PRCDA,5,X)) Q:+X'=X I $P($G(^PRC(444,PRCDA,5,X,0)),U,2)="m" S Y=1 Q
I 'Y D EN^DDIOL("There are no vendors for Manual Solicitation") Q 0
MANA K %ZIS S %ZIS("A")="90 Column Printer for Manual RFQ: "
S %ZIS("B")="",%ZIS="PQ" D ^%ZIS I POP Q 1
I $E(IOST)'="P"!(IOM'>89) D ^%ZISC,EN^DDIOL("Device must be a printer supporting 90 characters per line.") G MANA
I $D(IO("Q")) S ZTRTN="PROCESS^PRCHQM1",ZTSAVE("DA")=PRCDA D ^%ZTLOAD,HOME^%ZIS G:$G(ZTSK)>0 XMANUAL Q 1
S DA=PRCDA D PROCESS^PRCHQM1
XMANUAL ;
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHQ2B 6897 printed Dec 13, 2024@02:09:43 Page 2
PRCHQ2B ;(WASH IRMFO)/LKG-RFQ Enter/Edit cont ;9/8/96 21:07
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 IF $PIECE(PRC410(3),U,4)]""
Begin DoDot:1
+4 SET ^PRC(444,PRCDA,5,0)="^"_$PIECE(^DD(444,20,0),U,2)_"^1^1"
+5 SET ^PRC(444,PRCDA,5,1,0)=$PIECE(PRC410(3),U,4)_";PRC(440,"
End DoDot:1
+6 IF $PIECE(PRC410(3),U,4)=""
Begin DoDot:1
+7 NEW DIC,DIE,DR,Y,DA
+8 SET DIC=444.1
SET DIC(0)="XL"
SET DLAYGO=444.1
SET X=$PIECE(PRC410(2),U)
DO ^DIC
KILL DLAYGO
+9 if +Y<1
QUIT
+10 SET ^PRC(444,PRCDA,5,0)="^"_$PIECE(^DD(444,20,0),U,2)_"^1^1"
+11 SET ^PRC(444,PRCDA,5,1,0)=+Y_";PRC(444.1,"
+12 IF $PIECE(Y,U,3)
Begin DoDot:2
+13 SET DA=+Y
SET DIE=444.1
LOCK +^PRC(444.1,DA):5
IF '$TEST
WRITE !,"Vendor ",$PIECE(PRC410(2),U)," is being edited by another user."
QUIT
+14 SET PRCX=$PIECE(PRC410(2),U,2)
IF PRCX]""
SET DR="1///^S X=PRCX"
DO ^DIE
+15 SET PRCX=$PIECE(PRC410(2),U,3)
IF PRCX]""
SET DR="2///^S X=PRCX"
DO ^DIE
+16 SET PRCX=$PIECE(PRC410(2),U,4)
IF PRCX]""
SET DR="3///^S X=PRCX"
DO ^DIE
+17 SET PRCX=$PIECE(PRC410(2),U,5)
IF PRCX]""
SET DR="4///^S X=PRCX"
DO ^DIE
+18 SET PRCX=$PIECE(PRC410(2),U,6)
IF PRCX]""
SET DR="4.2///^S X=PRCX"
DO ^DIE
+19 SET PRCX=$PIECE(PRC410(2),U,7)
IF PRCX]""
SET DR="4.4////^S X=PRCX"
DO ^DIE
+20 SET PRCX=$PIECE(PRC410(2),U,8)
IF PRCX]""
SET DR="4.6///^S X=PRCX"
DO ^DIE
+21 SET PRCX=$PIECE(PRC410(2),U,9)
IF PRCX]""
SET DR="4.8///^S X=PRCX"
DO ^DIE
+22 SET PRCX=$PIECE(PRC410(2),U,10)
IF PRCX]""
SET DR="5///^S X=PRCX"
DO ^DIE
+23 LOCK -^PRC(444.1,DA)
End DoDot:2
End DoDot:1
+24 SET DA=PRCDA410
SET DIE="^PRC(443,"
SET DR="1.5////79"
DO ^DIE
KILL DA,DIE,DR
+25 if $DATA(PRCDA410)
LOCK -(^PRCS(410,PRCDA410),^PRC(443,PRCDA410))
+26 KILL DA,I,PRCDA410,PRC410,PRC443,PRCE,PRCI,PRCJ,PRCK,PRCL,PRCM,PRCN,PRCP,PRCQ,PRCX,PRCY,X,Y
+27 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Do you wish to import items from an additional 2237? "
+28 SET DIR("B")="NO"
+29 SET DIR("?",1)="If you answer 'YES', you will be prompted for an Assigned to Purchasing Agent"
+30 SET DIR("?",2)="2237 with the same Fund Control Point."
+31 SET DIR("?")="All item information on that 2237 will be imported into this RFQ"
+32 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO INDX
if Y'=1
GOTO INDX
+33 SET PRCX=$PIECE($PIECE(^PRC(444,PRCDA,0),U,14)," ")
LOOP KILL DIC
SET DIC="^PRC(443,"
SET DIC(0)="AEMN"
+1 SET DIC("S")="I "";70;80;""[("";""_$P(^(0),U,7)_"";""),PRCX=$P($P($G(^PRCS(410,Y,0)),U),""-"",4),$P($G(^PRCS(410,Y,4)),U,5)="""""
+2 SET DIC("A")="Enter additional 2237 Transaction #: "
DO ^DIC
KILL DIC
+3 IF Y<1!$DATA(DTOUT)!$DATA(DUOUT)
GOTO INDX
+4 SET PRCDA410=+Y
+5 LOCK +^PRC(443,PRCDA410):5
IF '$TEST
WRITE !,"Work Sheet entry in use, please try later!"
GOTO INDX
+6 LOCK +^PRCS(410,PRCDA410):5
IF '$TEST
WRITE !,"Someone is editing the source 2237, please try later!"
GOTO INDX
+7 WRITE !,"Importing item information into this RFQ entry..."
+8 SET PRC410(3)=$GET(^PRCS(410,PRCDA410,3))
+9 DO IT^PRCHQ2A
+10 SET DA=PRCDA410
SET DIE="^PRC(443,"
SET DR="1.5////79"
DO ^DIE
KILL DA,DIE,DR
+11 LOCK -(^PRCS(410,PRCDA410),^PRC(443,PRCDA410))
+12 KILL PRCDA410
+13 GOTO LOOP
INDX ;Index the entry
+1 KILL PRC410
+2 DO NOW^%DTC
SET $PIECE(^PRC(444,PRCDA,1),U,9,10)=DUZ_U_%
KILL %,%H,%I
+3 WRITE !,"Building the cross references..."
+4 SET DIK="^PRC(444,"
SET DA=PRCDA
DO IX1^DIK
KILL DA,DIK
+5 if $DATA(DUOUT)!$DATA(DIRUT)!$DATA(DTOUT)
GOTO OUT
CONT DO EDIT
LOCK -^PRC(444,PRCDA)
+1 IF '$DATA(DTOUT)&'$DATA(DUOUT)&'$DATA(DIRUT)&'$DATA(DIROUT)
if $GET(PRCNEW)
GOTO B^PRCHQ2
GOTO A^PRCHQ2
OUT ;
+1 if $DATA(PRCDA410)
LOCK -(^PRCS(410,PRCDA410),^PRC(443,PRCDA410))
+2 if $DATA(PRCDA)
LOCK -^PRC(444,PRCDA)
+3 KILL DA,DIC,DIRUT,DIROUT,DTOUT,DUOUT,PRCDA,PRCDA410,PRCOUT,PRCX,X,Y,PRCNEW,PRCEDIT
+4 QUIT
EDIT ;Edit RFQ
+1 NEW %,%H,%I
+2 IF PRCEDIT="s"
Begin DoDot:1
+3 KILL DA
SET DDSPARM="CS"
+4 SET DDSFILE=444
SET DR="[PRCHQ1]"
SET DA=PRCDA
SET DDSPAGE=1
DO ^DDS
+5 KILL DA,DDSFILE,DR,DDSPAGE,DDSPARM,DIMSG,PRCMSG,%
End DoDot:1
+6 IF PRCEDIT="i"
Begin DoDot:1
+7 NEW PRCMSG,PRCI,PRCX,PRCRD,PRCRQD,PRCDA2,PRCITMO,PRCIEN,PRCVEN
+8 SET PRCMSG=""
DO ESIG^PRCUESIG(DUZ,.PRCMSG)
+9 IF PRCMSG'=1
DO EN^DDIOL("Electronic Signature Failed, Edit aborted")
SET PRCERR=10
QUIT
+10 KILL DA
SET DIE="^PRC(444,"
SET DA=PRCDA
SET DR="[PRCHQ RFQ REQUEST]"
DO ^DIE
KILL DIE,DR
+11 DO NOW^%DTC
SET $PIECE(^PRC(444,PRCDA,1),U,9,10)=DUZ_U_%
+12 IF $DATA(DTOUT)
SET PRCERR=10
QUIT
+13 IF $DATA(DUOUT)
KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Do you wish to continue? "
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF Y'=1
SET PRCERR=10
QUIT
+14 KILL DUOUT
+15 SET PRCI=0
+16 FOR
SET PRCI=$ORDER(^PRC(444,PRCDA,5,PRCI))
if +PRCI'=PRCI
QUIT
Begin DoDot:2
+17 SET PRCX=$GET(^PRC(444,PRCDA,5,PRCI,0))
if $PIECE(PRCX,U)'["PRC(444.1,"
QUIT
+18 WRITE !!,"Editing Solicited Vendor in RFQ Temporary Vendor File..."
+19 LOCK +^PRC(444.1,+PRCX):3
IF '$TEST
SET X="Vendor "_$PIECE($GET(^PRC(444.1,+PRCX,0)),U)_" is locked, please try later!"
DO EN^DDIOL(X)
QUIT
+20 KILL DA
SET DA=+PRCX
SET DIE="^PRC(444.1,"
SET DR=".01;18.3;38;4.8;5;46;1R;2;3;4;4.2R;4.4R;4.6"
+21 DO ^DIE
KILL DIE,DR,DA
LOCK -^PRC(444.1,+PRCX)
+22 IF $DATA(DTOUT)
SET PRCERR=10
QUIT
+23 IF $DATA(DUOUT)
KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Do you wish to continue? "
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF Y'=1
SET PRCERR=10
QUIT
+24 KILL DUOUT
End DoDot:2
if $GET(PRCERR)
QUIT
+25 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Do you wish to view the RFQ? "
+26 SET DIR("B")="YES"
DO ^DIR
KILL DIR
IF $DATA(DIROUT)!$DATA(DIRUT)
SET PRCERR=10
QUIT
+27 IF Y=1
Begin DoDot:2
+28 SET PRCRFQ=$PIECE($GET(^PRC(444,PRCDA,0)),U)
+29 SET DIC=444
SET BY=.01
SET FLDS="[PRCHQ RFQ FULL]"
SET L=0
SET (FR,TO)=PRCRFQ
SET DHD="@"
+30 DO EN1^DIP
KILL BY,DIC,DHD,FLDS,FR,L,TO
End DoDot:2
End DoDot:1
+31 IF $GET(DDSCHANG)=1!($GET(DDSSAVE)=1)!(PRCEDIT="i"&'$GET(PRCERR))
Begin DoDot:1
+32 NEW PRCRFQ,PRCTYPE,PRCNOPRT
SET PRCRFQ=$PIECE(^PRC(444,PRCDA,0),U)
+33 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Do you wish to transmit this RFQ to vendors? "
+34 SET DIR("B")="YES"
SET DIR("?")="Accept default of 'YES' to transmit, enter 'NO' to avoid transmitting."
+35 DO ^DIR
KILL DIR
if Y'=1!$DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+36 IF $PIECE($GET(^PRC(444,PRCDA,1)),U,8)'="y"
IF $PIECE($GET(^PRC(444,PRCDA,5,0)),U,4)'>0
DO EN^DDIOL("Warning - Transmit aborted as there are NO RECIPIENTS!")
QUIT
+37 SET PRCTYPE="00"
+38 KILL PRCERR
+39 DO TRANS840^PRCHQ4A(PRCTYPE)
+40 IF $GET(PRCERR)
DO EN^DDIOL("Due to Error Conditions Transmission Was Aborted!")
QUIT
+41 SET PRCNOPRT=$$MANUAL
+42 IF $PIECE($GET(^PRC(444,PRCDA,1)),U,11)=""&PRCNOPRT
DO EN^DDIOL("RFQ has not been transmitted, use option Edit Incomplete RFQ to complete.")
QUIT
+43 if PRCNOPRT
DO EN^DDIOL("Required manual RFQs were not printed, use option Manual Print of RFQ.")
+44 IF $PIECE($GET(^PRC(444,PRCDA,1)),U,11)]""!('PRCNOPRT)
Begin DoDot:2
+45 NEW PRCAR,PRCSTAT,PRCSTRG
+46 SET PRCSTRG="CANCELLED^INCOMPLETE^PENDING QUOTES^CLOSED^EVALUATION COMPLETE^AWARDED"
SET PRCSTAT=$PIECE(PRCSTRG,U,$PIECE(^PRC(444,PRCDA,0),U,8)+1)
+47 KILL DA
SET DA=PRCDA
SET DR="7////2"
SET DIE="^PRC(444,"
DO ^DIE
KILL DA,DIE,DR
+48 SET PRCAR(1)="The status of RFQ #: "_PRCRFQ_" has been changed from"
+49 SET PRCAR(2)=" '"_PRCSTAT_"' to '"_$PIECE(PRCSTRG,U,$PIECE($GET(^PRC(444,PRCDA,0)),U,8)+1)_"'."
+50 DO EN^DDIOL(.PRCAR)
End DoDot:2
End DoDot:1
+51 KILL DDSCHANG,DDSSAVE,PRCERR
+52 QUIT
MANUAL() ;Print Manual RFQ
+1 NEW X,Y,POP,%,%H,%I,DA
+2 SET X=0
SET Y=0
+3 FOR
SET X=$ORDER(^PRC(444,PRCDA,5,X))
if +X'=X
QUIT
IF $PIECE($GET(^PRC(444,PRCDA,5,X,0)),U,2)="m"
SET Y=1
QUIT
+4 IF 'Y
DO EN^DDIOL("There are no vendors for Manual Solicitation")
QUIT 0
MANA KILL %ZIS
SET %ZIS("A")="90 Column Printer for Manual RFQ: "
+1 SET %ZIS("B")=""
SET %ZIS="PQ"
DO ^%ZIS
IF POP
QUIT 1
+2 IF $EXTRACT(IOST)'="P"!(IOM'>89)
DO ^%ZISC
DO EN^DDIOL("Device must be a printer supporting 90 characters per line.")
GOTO MANA
+3 IF $DATA(IO("Q"))
SET ZTRTN="PROCESS^PRCHQM1"
SET ZTSAVE("DA")=PRCDA
DO ^%ZTLOAD
DO HOME^%ZIS
if $GET(ZTSK)>0
GOTO XMANUAL
QUIT 1
+4 SET DA=PRCDA
DO PROCESS^PRCHQM1
XMANUAL ;
+1 QUIT 0
