113 lines
6.0 KiB
Mathematica
113 lines
6.0 KiB
Mathematica
PRCHNRQ ;ID/RSD-ENTER/EDIT REQUISITIONS ;3/10/98 11:43 AM
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
N POCARD
|
|
I $P($G(^PRC(442,PRCHPO,0)),U,2)=25 S POCARD=1
|
|
S PRCHN("PO")=$P($P(^PRC(442,PRCHPO,0),"-",2),U,1),PRCHLCNT=$P(^(0),U,14),Y=$G(^PRC(440,PRCHV,2)),PRCHN("LSA")=$P(Y,U,5),PRCHN("MB")=$S(PRCHDT:$P(Y,U,3),1:$P(Y,U,6))
|
|
S PRCHN("SFC")=$P(^PRC(442,PRCHPO,0),U,19)
|
|
S X="",PRCHN("ID")=PRCHN("PO") F I=1:1 S X=$E(PRCHN("PO"),I) Q:X="" I X=+X S PRCHN("ID")=$E(PRCHN("PO"),1,I-1)_$E(PRCHN("PO"),I+1,6) Q
|
|
I 'PRCHN("MP") W !?5,"Method of Processing is undefined !",$C(7) G INC
|
|
K ^PRC(442,PRCHPO,9) S $P(^PRC(442,PRCHPO,0),U,15,16)="0^0"
|
|
I '$G(PRCHPC),'$G(PRCHDELV),PRCHDT D FPDS^PRCHFPD2
|
|
;
|
|
EST G INC:'$D(PRCHPO) I 'PRCHEST,PRCHESTL S $P(^PRC(442,PRCHPO,0),U,18)=""
|
|
I PRCHEST D EST^PRCHNPO6
|
|
S PRCHTYP="A" S:$D(PRCHISMS) PRCHTYP="I" K PRCHNM
|
|
D EN2A^PRCHNPO7
|
|
;
|
|
; FIX FOR NOIS SDH-1196-N0212
|
|
;
|
|
S (D0,DA)=PRCHPO
|
|
D ^PRCHSF
|
|
;
|
|
; END OF FIX
|
|
;
|
|
S (X,Y)=4,DA=PRCHPO D UPD^PRCHSTAT S %=1,%B="",%A=" Review Requisition " D ^PRCFYN G:%=-1 INC I %=1 S D0=PRCHPO D ^PRCHDP1
|
|
S VAR2="" I $G(PRCHPC)'=1 D NEW^PRCOEDC(PRCHPO,.VAR2) I $G(VAR2)]"" W !,VAR2 K VAR2 G INC
|
|
I $G(POCARD)=1 S FILE=442 D LIMIT^PRCHCD0 I $G(ERROR) K FILE,ERROR G INC
|
|
G:$$ISMSFLAG^PRCPUX2(PRC("SITE"))=2 SIG
|
|
I '$D(PRCHLOG) G SIG ; LOG BYPASS SWITCH
|
|
K PRCHNM G:PRCHSC=9 SIG I $D(^PRC(442,PRCHPO,18)),$P(^(18),U,6)]"" W !!,$C(7),"LOG code sheets have already been created.",!! G SIG
|
|
I $D(^PRC(442,PRCHPO,1)),$P(^(1),U,18)="N" D W2 G SIG
|
|
I $G(POCARD) G SIG
|
|
W !!!! S %B="",%A=" Create LOG code sheets ",%=2 D ^PRCFYN G:%=-1 INC G:%'=1 SIG
|
|
S PRCHENT="PRCHNRQ" D EN11^PRCHEC G:'$D(PRCHPO) INC
|
|
;
|
|
SIG I PRCHSC'=9,$D(PRCHLOG) D:'$D(^PRC(442,PRCHPO,18)) W I $D(^PRC(442,PRCHPO,18)),$P(^(18),U,6)']"",'$G(POCARD) D W
|
|
I '$G(POCARD),$D(PRCHISMS),(PRCHSC=9!(PRCHSC=1)) I $P($G(^PRC(442,PRCHPO,12)),"^",10)="" D G:%=1 ISMS G INC
|
|
.W !! S %A=" Do you want to send code sheet to Austin? " S %=2 D ^PRCFYN Q
|
|
W !! S %A=" Affix signature to Requisition and Print ",%B="If you answer 'Y' (YES), you can no longer edit this Order except by Amendment.",%B(1)="You must answer YES before you can receive items on this Order."
|
|
S %=2 D ^PRCFYN G:%'=1 INC
|
|
I '$D(PRCHNM) S DA=PRCHPO,P=+PRC("PER") S PRCSIG="" D ESIG^PRCUESIG(DUZ,.PRCSIG) S ROUTINE="PRCUESIG" I PRCSIG<1 D QQ G INC
|
|
;
|
|
PRT ;SET STATUS TO 'ORDERED (NO FISCAL ACTION REQUIRED' IF SUPPLY FUND, 'PENDING FISCAL ACTION' OTHERWISE
|
|
S FILE=442 D:$D(PRCHPO) CHECK^PRCHSWCH K FILE
|
|
S (PRCHSTAT,X)=$S(PRCHN("SFC")=2!$G(POCARD)!$G(PRCHOBL)=1:22,1:10),DA=PRCHPO D ENS^PRCHSTAT
|
|
S (D0,DA)=PRCHPO D ^PRCHSF
|
|
S PRCSIG="" D ENCODE^PRCHES5(PRCHPO,DUZ,.PRCSIG) S ROUTINE=$T(+0) I PRCSIG<1 D QQ G Q
|
|
I $G(PRCHPC)!$G(PRCHDELV) D
|
|
. I $P($G(^PRC(442,PRCHPO,23)),U,8)]"" D
|
|
. . S PRCHCD=$P(^PRC(442,PRCHPO,23),U,8)
|
|
. . S PRCHPOMT=$P(^PRC(442,PRCHPO,0),U,15)
|
|
. . S $P(^(2),U)=+$P($G(^PRC(440.5,PRCHCD,2)),U)+PRCHPOMT
|
|
. S PODA=DA,DA=CDA S X=$P(^PRC(442,PRCHPO,0),U,15) D ESIG^PRCH410 S DA=PODA K PODA
|
|
I PRCHN("MP")=25 D S $P(^PRC(442,PRCHPO,24),U)=1 G INV
|
|
. I $G(PRCHPC)'=1 N PRCOPODA S PRCOPODA=PRCHPO W !!,"...now generating the PHA transaction" D ^PRCOEDI
|
|
. I '$P($G(^PRC(442,PRCHPO,23)),U,11) D
|
|
. . I '$P(^PRC(442,PRCHPO,0),U,12) S DA=PRCHPO D START^PRCH410 D Q
|
|
. . . S PODA=PRCHPO,DA=CDA S X=$P(^PRC(442,PRCHPO,0),U,15) D ESIG^PRCH410 S DA=PODA K PODA
|
|
. . . ;Update file #440.5
|
|
. . . S PRCHCD=+$P(^PRC(442,PRCHPO,23),U,8)
|
|
. . . S PRCHPOMT=$P(^PRC(442,PRCHPO,0),U,15)
|
|
. . . S $P(^PRC(440.5,PRCHCD,2),U,1)=$P(^PRC(440.5,PRCHCD,2),U,1)+PRCHPOMT
|
|
. . I $P(^PRC(442,PRCHPO,0),U,12) D COMM^PRCSPC(PRCHPO,$P(^PRC(442,PRCHPO,0),U,10))
|
|
;
|
|
I $G(PRCHSTAT)'="",PRCHSTAT'=10 D S:$P(^PRC(442,PRCHPO,0),U,2)=26 $P(^PRC(442,PRCHPO,24),U)=1 G INV
|
|
. N PRCOPODA S PRCOPODA=PRCHPO D ^PRCOEDI,SUPP^PRCFFMO
|
|
I $G(PRCHOBL)=2 N PRCOPODA S PRCOPODA=PRCHPO W !!,"...now generating the PHA transaction" D ^PRCOEDI
|
|
;S PRCOPODA=PRCHPO I PRCHN("SFC")=2!$G(POCARD) D
|
|
;. D:'$G(POCARD) OBL D:$G(PRCHPC)'=1 ^PRCOEDI
|
|
;. I $G(POCARD)&($P(^PRC(442,PRCHPO,0),U,12)]"") D
|
|
;. . D COMM^PRCSPC(PRCHPO,$P(^PRC(442,PRCHPO,0),U,10)) Q
|
|
;. I $G(PRCHN("SFC"))=2 D SUPP^PRCFFMO W VAR2 H 2
|
|
INV S DA=PRCHPO D UPDATE^PRCPWIU
|
|
;I $G(PRCH("SFC"))'=2,'$G(POCARD) D
|
|
;. I $G(PRCHOBL)=1 D:$G(PRCHPC)'=1 ^PRCOEDI D SUPP^PRCFFMO W VAR2 H 2
|
|
;. I $G(PRCHOBL)=2 D:$G(PRCHPC)'=1 ^PRCOEDI
|
|
I $D(PRCHNRQ) S:PRCHNRQ="" PRCHNRQ=1
|
|
I '$G(POCARD) S PRCHQ("DEST")="F",D0=PRCHPO,PRCHQ="^PRCHFPNT" D ^PRCHQUE
|
|
I $G(PRCHN("SFC"))=2!$G(POCARD) S:'$G(POCARD) PRCHQ("DEST")="S" S D0=PRCHPO,PRCHQ="^PRCHFPNT" D ^PRCHQUE
|
|
G Q
|
|
;
|
|
QQ S:'$D(ROUTINE) ROUTINE=$T(+0) W !!,$$ERR^PRCHQQ(ROUTINE,PRCSIG) W:PRCSIG=0!(PRCSIG=-3) !,"Notify Application Coordinator!",$C(7) S DIR(0)="EAO",DIR("A")="Press <return> to continue" D ^DIR K PRCSIG,ROUTINE
|
|
Q
|
|
;
|
|
Q L D Q^PRCHNPO4 K PRCF,PRCFA,PRCHENT,PRCHLOG,PRCHN,PRCHTYP,ROUTINE
|
|
Q
|
|
;
|
|
ISMS ;CHECK ISMS SWITCH AND CREATE ISMS COD
|
|
I $$ISMSFLAG^PRCPUX2(PRC("SITE"))=2 S PRCHTRAN="" D
|
|
.I PRCHSC=1 S PRCHTRAN=$S($P(^PRC(442,PRCHPO,0),U,19)=2:"TO1",1:"SO1") D EN11^PRCHEI(PRCHTRAN)
|
|
.I PRCHSC=9 S PRCHTRAN="PO1" D EN11^PRCHEI(PRCHTRAN)
|
|
G Q
|
|
;
|
|
INC D Q G ERR^PRCHNPO
|
|
;
|
|
OBL ;UPDATE CONTROL POINT OBLIGATED BALANCE
|
|
I $D(^PRC(442,PRCHPO,18)),$P(^(18),U,12) W $C(7),!,"This Supply Fund order has already updated the Control Point",!,"Obligated Balance.",!! Q
|
|
I $D(PRCHN("SFC")),PRCHN("SFC")=2 S $P(^PRC(442,PRCHPO,18),U,12)=1
|
|
S DA=+$P(^PRC(442,PRCHPO,0),U,12) G:'DA ERR G:'$D(^PRCS(410,DA,0)) ERR
|
|
I $D(PRC("PER")) S PRCSIG="" D ENCODE^PRCSC2(DA,DUZ,.PRCSIG) S ROUTINE=$T(+0) I PRCSIG<1 D QQ G Q
|
|
S X=$P(^PRCS(410,DA,4),"^",8) D TRANK^PRCSES
|
|
S X=$P(^PRC(442,PRCHPO,0),U,16),Y=$P(^(0),U,10),$P(^PRCS(410,DA,4),"^",4)=DT,$P(^(9),"^",2)=Y,$P(^(4),"^",3)=X,$P(^(4),"^",8)=X D TRANS^PRCSES,TRANS1^PRCSES
|
|
Q
|
|
;
|
|
ERR W $C(7),!!,"Control Point Balances NOT updated!!"
|
|
Q
|
|
;
|
|
W Q:'$D(PRCHLOG) W $C(7),!!,"WARNING--LOG code sheets have NOT been created!!"
|
|
Q
|
|
;
|
|
W2 W !!,$C(7),"LOG code sheets for non-expendable good not yet programmed.",!,"Use FALCON or KEYPUNCH A CODESHEET option to create these.",!!
|
|
Q
|