| 1 | PRCBMT ;WISC@ALTOONA/CLH-MULTIPLE TRANSACTIONS ;9-6-90/10:27
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S PRCF("X")="ABFS" D ^PRCFSITE I '% D OUT Q
|
|---|
| 5 | EN S (COUNT,PRCB("TN"))=0 I '$D(^PRCF(421.1,0)) W $C(7),!!,"YOU HAVE AN UNDEFINED FILE. CALL SITE MANAGER.",!! Q
|
|---|
| 6 | S LOCKFLG=0
|
|---|
| 7 | GETNUM ;GET TEMP TRANS NUMBER
|
|---|
| 8 | L +^PRCF(421.1,0):5
|
|---|
| 9 | E D EN^DDIOL("File in use. Please try later.") QUIT
|
|---|
| 10 | S TNUM=$P(^PRCF(421.1,0),"^",3)+1,PRCB("TN")="0000"_TNUM K TNUM
|
|---|
| 11 | L -^PRCF(421.1,0)
|
|---|
| 12 | S DIC="^PRCF(421.1,",DLAYGO=421.1,DIC(0)="LMN",X="T-"_$E(PRCB("TN"),$L(PRCB("TN"))-4,$L(PRCB("TN"))) D ^DIC K DIC S COUNT=COUNT+1 Q:COUNT>5 G:$P(Y,"^",3)'=1 GETNUM
|
|---|
| 13 | S PRCB("TN")=$P(Y,"^",2),DA=+Y,PRCB("TDA")=+Y
|
|---|
| 14 | W $C(7),!!,"This has been assigned TRANSACTION NUMBER: ",PRCB("TN"),".",!,"Please note and use for editing of this transaction.",!
|
|---|
| 15 | S PRCB("ASK")="" D DIE
|
|---|
| 16 | S %A="Enter another transaction",%B="",%=2 D ^PRCFYN I %=1 S (COUNT,PRCB("TN"))=0 G EN
|
|---|
| 17 | D OUT Q
|
|---|
| 18 | DIE ;I $D(PRCB("ASK")) D DEL Q
|
|---|
| 19 | S PRCB("NOFLG")=""
|
|---|
| 20 | D EDIT^PRCBMT1 I $D(PRCB("^")) K PRCB("^") D DEL Q
|
|---|
| 21 | D VERI I $D(PRCB("ERR",1)) K PRCB("ER") W !,$C(7),"This transaction contains no entries. No further action can be taken." G DIE
|
|---|
| 22 | I $D(PRCB("ERR")) K PRCB("ERR") S PRCB("ASK")="" D REVIEW^PRCBMT1 W !,$C(7),"This transaction contains at least one entry with no funding information.",!,"Either correct or delete this entry."
|
|---|
| 23 | I PRCB("NOFLG")=1 K PRCB("ASK") Q
|
|---|
| 24 | D PST^PRCBMT1 I $D(PRCB("^")) K PRCB("^") D DEL Q
|
|---|
| 25 | Q
|
|---|
| 26 | DEL G:LOCKFLG=1 OUT
|
|---|
| 27 | I '$D(PRCB("AUTOKILL")) K PRCB("AUTOKILL") S %A="Are you sure you want to DELETE temporary transaction number "_PRCB("TN"),%=2,%B="" D ^PRCFYN S:%<0 PRCB("^")="" I %'=1 S X=" <No Action Taken>" D MSG^PRCFQ Q
|
|---|
| 28 | K PRCB("AUTOKILL") S DIK="^PRCF(421.1,",DA=PRCB("TDA") D ^DIK S X=" <Temporary Transaction Number "_PRCB("TN")_" has been Deleted.>*" D MSG^PRCFQ W !
|
|---|
| 29 | OUT K DIC,DIE,DIK,DA,DUOUT,POP,X,TNUM,PRCB,PRCF("SIFY"),CNT,COUNT,TOREC,DR,REC,CHK,NXT,PRCBE,PRCBNUM,DATA,DLAYGO,FREC,LOCKFLG
|
|---|
| 30 | Q
|
|---|
| 31 | INPT ;INPUT TRANSFORM
|
|---|
| 32 | N DIX,DIC,D0,DO
|
|---|
| 33 | S DIC("S")="I $D(^PRC(420,+PRC(""SITE""),1,+Y))",DIC="^PRC(420,"_PRC("SITE")_",1,",DIC(0)="EMNQZ" D ^DIC S X=$P(Y,"^",2) I +Y<0 K X Q
|
|---|
| 34 | Q
|
|---|
| 35 | VERI ;VERIFY DATA
|
|---|
| 36 | K PRCB("ERR") I $S('$D(^PRCF(421.1,DA,1,0)):1,$P(^(0),"^",3)<1:1,1:0) S PRCB("ERR",1)="" QUIT
|
|---|
| 37 | S DA(1)=0 F I=1:1 S DA(1)=$O(^PRCF(421.1,DA,1,DA(1))) Q:'DA(1) D VER1 Q:$D(PRCB("ERR"))
|
|---|
| 38 | Q
|
|---|
| 39 | VER1 S PRCB("ERR",2,DA(1))="",REC=^PRCF(421.1,DA,1,DA(1),0),DATA=0 F J=2:1:6 I +$P(REC,"^",J)'=0 K PRCB("ERR",2,DA(1)) Q
|
|---|
| 40 | I $P($G(^PRCF(421.1,DA,1,DA(1),4)),"^",6)="" S PRCB("ERR",2,DA(1))=""
|
|---|
| 41 | Q
|
|---|
| 42 | POST S PRCF("X")="ABS",LOCKFLG=0,PRCB("NOFLG")="" D ^PRCFSITE Q:'%
|
|---|
| 43 | S DIC="^PRCF(421.1,",DIC("A")="Select TEMPORARY TRANSACTION NUMBER: ",DIC(0)="AEQMN" D ^DIC G:+Y<0 OUT S PRCB("TDA")=+Y,DA=+Y,PRCB("TN")=$P(Y,"^",2) K DIC
|
|---|
| 44 | D DIE S DIC("A")="Select Next TEMPORARY TRANSACTION NUMBER: " G POST
|
|---|
