PRCBMT1 ;WISC@ALTOONA/CLH-MULTIPLE TRANS CON'T ;10-3-89/2:09 PM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
REVIEW ;REVIEW DATA BEFORE POSTING
I '$D(PRCB("ASK")) S %A="Do you want to review this transaction",%B="",%=1 D ^PRCFYN S:%<0 PRCB("^")="" Q:%'=1
S:$D(PRCB("ASK")) IOP=ION K PRCB("ASK") N DA S DIC="^PRCF(421.1,",L=0,BY=".01",(TO,FR)=PRCB("TN"),FLDS="[PRCB TEMP REVIEW]" D EN1^DIP Q
EDIT I '$D(PRCB("ASK")) S %A="Do you want to edit this transaction",%B="",%=1 D ^PRCFYN S:%<0!(%=2&($D(PRCB("ERR",1)))) PRCB("^")="" K PRCB("ERR",1) S:%'=1 PRCB("ASK")="",PRCB("NOFLG")=1 Q:%'=1
K PRCB("ASK") S DA=PRCB("TDA"),DIE="^PRCF(421.1,",DR="[PRCB ENTER TRANS]" D ^DIE K DIE D REVIEW
OUT K DIC,TO,FR,BY,L,FLDS Q
NOTE S X="Make note of this transaction number: "_PRCB("TN")_" and use for editing/posting at later time." D MSG^PRCFQ Q
PST S %A="Are you ready to post this transaction",%B="",%=1 D ^PRCFYN D:%=1 G:%=1 EN1 I %<0 S PRCB("^")="" D NOTE Q
. D VERI^PRCBMT
. I $D(PRCB("ERR")) W !,$C(7)," Required data missing in this transaction" S %=2 K PRCB("ERR")
. QUIT
S %A="Do you want to edit this transaction",%B="",%=1 D ^PRCFYN I %<0 S PRCB("^")=""
I %'=1 D NOTE Q
S PRCB("ASK")="" D EDIT
I PRCB("NOFLG")=1 Q
G PST
;
EN1 S PRCB("TDA")=DA,(PRCBE,PRCBNUM)=0 F I=1:1 S PRCBNUM=$O(^PRCF(421.1,PRCB("TDA"),1,PRCBNUM)) Q:'PRCBNUM I $D(^PRCF(421.1,PRCB("TDA"),1,PRCBNUM,0)) S PRCBE=PRCBE+1 Q
S NXT=0 F I=1:1 S NXT=$O(^PRCF(421.1,PRCB("TDA"),1,NXT)) Q:'NXT D GETTRAN
I LOCKFLG'=1 S X=" <Transfer to Fund Distribution File Completed.>*" D MSG^PRCFQ W ! S PRCB("AUTOKILL")=""
D DEL^PRCBMT,OUT^PRCBMT
Q
GETTRAN ;GET TRANSACTION NUMBER AND POST DATA IN 421
S:'$D(CNT) CNT=0 D SEQNUM^PRCBE I '$D(X) D GETTRAN S CNT=CNT+1 I CNT>5 W !,"Unable to get next transaction number. Call Site manager for",!,"assistance." G OUT^PRCBMT
S X=PRCB("TRANS"),DIC="^PRCF(421,",DLAYGO=421,DIC(0)="LOX" D ^DIC I $P(Y,"^",3)'=1 G GETTRAN
S PRCB("PDA")=+Y,LOCKFLG=0
L +^PRCF(421,PRCB("PDA")):5
E D EN^DDIOL("File in use by another user. Please try later.") S LOCKFLG=1 QUIT
L +^PRCF(421.1,PRCB("TDA")):10
E D EN^DDIOL("File in use. Please try later.") L -^PRCF(421,PRCB("PDA")) S LOCKFLG=1 QUIT
S TOREC=^PRCF(421,PRCB("PDA"),0)
S FREC(0)=^PRCF(421.1,PRCB("TDA"),1,NXT,0)
S $P(TOREC,"^",2)=$P(FREC(0),"^"),$P(TOREC,"^",6)=$P(^PRCF(421.1,PRCB("TDA"),0),"^",2),$P(TOREC,"^",23)=$P(FREC(0),"^",6)
F I=2:1:5 S $P(TOREC,"^",I+5)=$P(FREC(0),"^",I)
W !!,$P(FREC(0),U)," Filed with transaction number ",PRCB("TRANS")
S I=$$ACC^PRC0C(PRC("SITE"),$P(TOREC,U,2)_U_PRC("FY")_U_PRC("BBFY"))
S $P(TOREC,"^",16)=PRCF("SIFY")_"-"_$P(I,U,11)_"-"_$P(I,U,5)_"-"_$P(I,U,2)
S $P(TOREC,"^",20)="0"
S ^PRCF(421,PRCB("PDA"),0)=TOREC,%X="^PRCF(421.1,"_PRCB("TDA")_",2,",%Y="^PRCF(421,"_PRCB("PDA")_",1," D %XY^%RCR
S ^PRCF(421,PRCB("PDA"),4)="0^0^0^0^"_$P(^PRCF(421.1,PRCB("TDA"),1,NXT,4),"^",5,6)
S ^PRCF(421,"AL",PRCF("SIFY"),0,PRCB("PDA"))="",^PRCF(421,"AC",PRCF("SIFY")_"-"_+FREC(0),PRCB("PDA"))=""
L -^PRCF(421,PRCB("PDA")),-^PRCF(421.1,PRCB("TDA"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCBMT1 3137 printed Dec 13, 2024@02:00:44 Page 2
PRCBMT1 ;WISC@ALTOONA/CLH-MULTIPLE TRANS CON'T ;10-3-89/2:09 PM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
REVIEW ;REVIEW DATA BEFORE POSTING
+1 IF '$DATA(PRCB("ASK"))
SET %A="Do you want to review this transaction"
SET %B=""
SET %=1
DO ^PRCFYN
if %<0
SET PRCB("^")=""
if %'=1
QUIT
+2 if $DATA(PRCB("ASK"))
SET IOP=ION
KILL PRCB("ASK")
NEW DA
SET DIC="^PRCF(421.1,"
SET L=0
SET BY=".01"
SET (TO,FR)=PRCB("TN")
SET FLDS="[PRCB TEMP REVIEW]"
DO EN1^DIP
QUIT
EDIT IF '$DATA(PRCB("ASK"))
SET %A="Do you want to edit this transaction"
SET %B=""
SET %=1
DO ^PRCFYN
if %<0!(%=2&($DATA(PRCB("ERR",1))))
SET PRCB("^")=""
KILL PRCB("ERR",1)
if %'=1
SET PRCB("ASK")=""
SET PRCB("NOFLG")=1
if %'=1
QUIT
+1 KILL PRCB("ASK")
SET DA=PRCB("TDA")
SET DIE="^PRCF(421.1,"
SET DR="[PRCB ENTER TRANS]"
DO ^DIE
KILL DIE
DO REVIEW
OUT KILL DIC,TO,FR,BY,L,FLDS
QUIT
NOTE SET X="Make note of this transaction number: "_PRCB("TN")_" and use for editing/posting at later time."
DO MSG^PRCFQ
QUIT
PST SET %A="Are you ready to post this transaction"
SET %B=""
SET %=1
DO ^PRCFYN
if %=1
Begin DoDot:1
+1 DO VERI^PRCBMT
+2 IF $DATA(PRCB("ERR"))
WRITE !,$CHAR(7)," Required data missing in this transaction"
SET %=2
KILL PRCB("ERR")
+3 QUIT
End DoDot:1
if %=1
GOTO EN1
IF %<0
SET PRCB("^")=""
DO NOTE
QUIT
+4 SET %A="Do you want to edit this transaction"
SET %B=""
SET %=1
DO ^PRCFYN
IF %<0
SET PRCB("^")=""
+5 IF %'=1
DO NOTE
QUIT
+6 SET PRCB("ASK")=""
DO EDIT
+7 IF PRCB("NOFLG")=1
QUIT
+8 GOTO PST
+9 ;
EN1 SET PRCB("TDA")=DA
SET (PRCBE,PRCBNUM)=0
FOR I=1:1
SET PRCBNUM=$ORDER(^PRCF(421.1,PRCB("TDA"),1,PRCBNUM))
if 'PRCBNUM
QUIT
IF $DATA(^PRCF(421.1,PRCB("TDA"),1,PRCBNUM,0))
SET PRCBE=PRCBE+1
QUIT
+1 SET NXT=0
FOR I=1:1
SET NXT=$ORDER(^PRCF(421.1,PRCB("TDA"),1,NXT))
if 'NXT
QUIT
DO GETTRAN
+2 IF LOCKFLG'=1
SET X=" <Transfer to Fund Distribution File Completed.>*"
DO MSG^PRCFQ
WRITE !
SET PRCB("AUTOKILL")=""
+3 DO DEL^PRCBMT
DO OUT^PRCBMT
+4 QUIT
GETTRAN ;GET TRANSACTION NUMBER AND POST DATA IN 421
+1 if '$DATA(CNT)
SET CNT=0
DO SEQNUM^PRCBE
IF '$DATA(X)
DO GETTRAN
SET CNT=CNT+1
IF CNT>5
WRITE !,"Unable to get next transaction number. Call Site manager for",!,"assistance."
GOTO OUT^PRCBMT
+2 SET X=PRCB("TRANS")
SET DIC="^PRCF(421,"
SET DLAYGO=421
SET DIC(0)="LOX"
DO ^DIC
IF $PIECE(Y,"^",3)'=1
GOTO GETTRAN
+3 SET PRCB("PDA")=+Y
SET LOCKFLG=0
+4 LOCK +^PRCF(421,PRCB("PDA")):5
+5 IF '$TEST
DO EN^DDIOL("File in use by another user. Please try later.")
SET LOCKFLG=1
QUIT
+6 LOCK +^PRCF(421.1,PRCB("TDA")):10
+7 IF '$TEST
DO EN^DDIOL("File in use. Please try later.")
LOCK -^PRCF(421,PRCB("PDA"))
SET LOCKFLG=1
QUIT
+8 SET TOREC=^PRCF(421,PRCB("PDA"),0)
+9 SET FREC(0)=^PRCF(421.1,PRCB("TDA"),1,NXT,0)
+10 SET $PIECE(TOREC,"^",2)=$PIECE(FREC(0),"^")
SET $PIECE(TOREC,"^",6)=$PIECE(^PRCF(421.1,PRCB("TDA"),0),"^",2)
SET $PIECE(TOREC,"^",23)=$PIECE(FREC(0),"^",6)
+11 FOR I=2:1:5
SET $PIECE(TOREC,"^",I+5)=$PIECE(FREC(0),"^",I)
+12 WRITE !!,$PIECE(FREC(0),U)," Filed with transaction number ",PRCB("TRANS")
+13 SET I=$$ACC^PRC0C(PRC("SITE"),$PIECE(TOREC,U,2)_U_PRC("FY")_U_PRC("BBFY"))
+14 SET $PIECE(TOREC,"^",16)=PRCF("SIFY")_"-"_$PIECE(I,U,11)_"-"_$PIECE(I,U,5)_"-"_$PIECE(I,U,2)
+15 SET $PIECE(TOREC,"^",20)="0"
+16 SET ^PRCF(421,PRCB("PDA"),0)=TOREC
SET %X="^PRCF(421.1,"_PRCB("TDA")_",2,"
SET %Y="^PRCF(421,"_PRCB("PDA")_",1,"
DO %XY^%RCR
+17 SET ^PRCF(421,PRCB("PDA"),4)="0^0^0^0^"_$PIECE(^PRCF(421.1,PRCB("TDA"),1,NXT,4),"^",5,6)
+18 SET ^PRCF(421,"AL",PRCF("SIFY"),0,PRCB("PDA"))=""
SET ^PRCF(421,"AC",PRCF("SIFY")_"-"_+FREC(0),PRCB("PDA"))=""
+19 LOCK -^PRCF(421,PRCB("PDA")),-^PRCF(421.1,PRCB("TDA"))
+20 QUIT
