| [613] | 1 | PRCFAC ;WISC/CTB-CODE SHEET GENERATOR ; 05/11/93 10:46 AM
|
|---|
| 2 | V ;;5.1;IFCAP;**97**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | LOG ;CREATE LOG CODE SHEETS
|
|---|
| 5 | S PRCHLOG="" D EN1 K PRCHLOG,PRCFASYS Q
|
|---|
| 6 | NEWCS K DA,PRCFDEL L +^PRCF(423,0):1 I '$T W $C(7),"Batching or purging is now going on.",!," Code sheet operations are temporarily suspended.",! Q
|
|---|
| 7 | S X=PRC("SITE")_"-CSC-"_PRC("FY") D COUNTER^PRCFACP I Y<0 K DA Q
|
|---|
| 8 | S X=Y_"-"_PRC("FY") S:$D(PRCFA("KP")) X="KP-"_X G:$D(^PRCF(423,"B",X)) NEWCS S DLAYGO=423,DIC=423,DIC(0)="LZ" D ^DIC K DLAYGO Q:Y<0 G:$P(Y,U,3)'=1 NEWCS
|
|---|
| 9 | G:$P(Y,"^",3)'=1 NEWCS W:'$D(PRCHAUTO) !!,"THIS CODE SHEET HAS BEEN ASSIGNED ID # ",$P(Y(0),U),!! S PRCFA("CSNAME")=$P(Y(0),"^")
|
|---|
| 10 | S (PRCFA("CSDA"),DA)=+Y I '$D(PRCFA("TTDATE")) D NOW^%DTC K %,%H,%I S PRCFA("TTDATE")=$E(X,4,7)_$E(X,2,3)
|
|---|
| 11 | S X=$P(^PRCF(423,+Y,0),U,1)_U_PRC("SITE")_U_PRCFA("EDIT")_U_PRCFA("TT")_U_PRCFA("TTDATE")_U_$S($D(PRCFA("REF")):$P(PRCFA("REF"),"^"),1:"")
|
|---|
| 12 | S X=X_"^^"_$S($D(PRC("PER")):+PRC("PER"),1:"")_"^^"_$S($D(PRCFA("SYS")):PRCFA("SYS"),1:"")
|
|---|
| 13 | S ^PRCF(423,+Y,0)=X,$P(^("TRANS"),U,1)="",$P(^("TRANS"),U,15)=$G(PRCFA("TTLEN"))
|
|---|
| 14 | I $D(PRCFA("REF")),PRCFA("REF")]"" S ^PRCF(423,"C",PRCFA("REF"),+Y)=""
|
|---|
| 15 | K C,DIC,X,Y I '$D(PRCHLOG) K PRCFA("REF"),PRCFA("TTLEN")
|
|---|
| 16 | Q
|
|---|
| 17 | TT K PRCFDEL S:$D(PRCFA("TT")) DIC("B")=PRCFA("TT") S DIC("A")="Select LOG TRANSACTION TYPE: " S DIC=420.4,DIC(0)="AEQMNZ"
|
|---|
| 18 | I '$D(PRCFASYS) S PRCFASYS=$S('$D(PRCHLOG):"FEEFENIRSISMCLIPRC",1:"LOG")
|
|---|
| 19 | S DIC("S")="I PRCFASYS[$P(^(0),U,6)" I $D(PRCFA("DICS")) S DIC("S")=DIC("S")_" "_PRCFA("DICS")
|
|---|
| 20 | ;I $D(PRCFA("ARCS")) S DIC("S")="I $P(^(0),U,7)=1"
|
|---|
| 21 | W:'$D(PRCFA("TTF")) ! S:$D(PRCFA("TTF")) X=PRCFA("TTF"),DIC(0)="MNZ" D ^DIC K DIC I +Y<0 S %=0 Q
|
|---|
| 22 | I "PRC"'[PRCFASYS,$P(Y(0),U,3)=""!($P(Y(0),U,5)'="Y") W !,"THIS TRANSACTION TYPE IS NOT YET ",$S($P(Y(0),"^",5)'="Y":"ACTIVATED",1:"AVAILABLE"),$C(7) Q:$D(PRCFA("TTF")) G TT
|
|---|
| 23 | S PRCFA("TT")=$P(Y(0),U,1),PRCFA("TTDA")=+Y,PRCFA("EDIT")=$P(Y(0),U,3),PRCFA("SYS")=$P(Y(0),"^",6),PRCFA("TTLEN")=$P(Y(0),"^",8),%=1
|
|---|
| 24 | ;K C,Y Q
|
|---|
| 25 | Q
|
|---|
| 26 | SE S U="^" D ^PRCFSITE G:'% OUT
|
|---|
| 27 | S %DT="",X="T" D ^%DT S PRCFA("TTDATE")=$E(Y,4,7)_$E(Y,2,3) Q
|
|---|
| 28 | EN1 ;CREATE A CODE SHEET
|
|---|
| 29 | K PRCFDEL,PRCFA("PODA") G:$D(PRCFAA) OUT
|
|---|
| 30 | S PRCF("X")="AS" D SE G:'$D(PRC("SITE")) OUT
|
|---|
| 31 | AM D TT G OUT:%'>0,EN1:'% D NEWCS G:'$D(DA) OUT S DIE="^PRCF(423,"
|
|---|
| 32 | S DR=PRCFA("EDIT") D ^DIE I $D(Y)=0 D ^PRCFACXM S X=PRCFA("TT"),X1=PRCFA("TTDATE") K PRCFA,P,PO,PODA S PRCFA("TT")=X,PRCFA("TTDATE")=X1 K X,X1 G EN1
|
|---|
| 33 | D DEL^PRCFACXM,OUT1 G EN1
|
|---|
| 34 | OUT1 K %,%DT,%X,%Y,A,B,C,DIG,DIH,DIU,DIV,DIW,DIK,DQ,I,M,N,PRCFASYS,X1,XL1 Q
|
|---|
| 35 | EN2 ;EDIT EXISTING TRANSACTION
|
|---|
| 36 | K PRCFDEL S PRCF("X")="AS" D SE G:'$D(PRC("SITE")) OUT K Q1
|
|---|
| 37 | S:'$D(PRCFASYS) PRCFASYS="FEEFENIRSCLI" K Q1 S DIC="^PRCF(423,",DIC(0)="AEMNQZ",DIC("S")="S ZX=^(0) I $P(ZX,U,10)]"""",PRCFASYS[$P(ZX,U,10),$P(ZX,U,2)=PRC(""SITE"")" D ^DIC K DIC("A") I Y<0 K PRCFASYS G OUT
|
|---|
| 38 | K DIE S DA=+Y,PRCFA("CSDA")=DA,DIE=DIC,PRCFA("EDIT")=$P(Y(0),"^",3),PRCFA("SYS")=$P(Y(0),"^",10),PRCFA("TTLEN")=$P(^PRCF(423,DA,"TRANS"),"^",15) K DIC
|
|---|
| 39 | I $P(Y,"^",2)["KP" W $C(7),!,"Code Sheet has been Key Punched and may not be edited with this option." G EN2
|
|---|
| 40 | EN21 S DR="" S:$D(PRCFA("EDIT")) DR=PRCFA("EDIT") S:$D(Y(0)) DR=$P(Y(0),U,3),PRCFA("TT")=$P(Y(0),"^",4) I DR="" W !,"THIS CODE SHEET CANNOT BE EDITED, IT MUST BE RE-ENTERED UNDER ANOTHER NUMBER.",$C(7) G EN2
|
|---|
| 41 | D ^DIE,^PRCFACXM G EN2
|
|---|
| 42 | OUT K %,B,D,D0,DA,DG,DIC,DIE,DIG,DIH,DIU,DIV,DIW,DLAYGO,DQ,DR,I,J,K,M,N,PRCFA,PRCFASYS,Q,Q1,S,X,XL1,Y,Z,PRCENT Q
|
|---|
| 43 | EN73 D ^PRCFSITE G:'% OUT
|
|---|
| 44 | EN731 K DIC("A") S D="C",DIC("S")="I $D(^(7)),+$P(^(0),U)=PRC(""SITE"") S FSO=$P(^PRCD(442.3,+^(7),0),U,3) I FSO=10",DIC("A")="Select Purchase Order Number: ",DIC=442,DIC(0)="AEQZ" D IX^DIC K DIC("S"),DIC("A"),FSO G:+Y<0 OUT S DA=+Y
|
|---|
| 45 | EN732 W !,$C(7) S %A="Are you sure that you do not want to obligate this order"
|
|---|
| 46 | S %=1,%B="Answering 'YES' will return the order to Supply, unobligated." D ^PRCFYN S PRCENT=% D:PRCENT=1 ^PRCFACS1 G:PRCENT=2 EN731 I PRCENT<0 W !,"No Action Taken." R X:3 G OUT
|
|---|
| 47 | LCK L @("+"_DIC_DA_"):0") E W !,$C(7),"ANOTHER USER IS EDITING THIS ENTRY!" K DA Q
|
|---|
| 48 | D REMOVE^PRCHES5(DA) S X=8 D ENF^PRCHSTAT W !!,"...Purchase Order has been returned, Supply has been notified...",$C(7),!
|
|---|
| 49 | I $G(DIC),$G(DA) L @("-"_DIC_DA_"):0")
|
|---|
| 50 | Q
|
|---|
