127 lines
6.6 KiB
Mathematica
127 lines
6.6 KiB
Mathematica
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
|