- 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 Feb 18, 2025@23:27:07 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