source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCBMT1.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1PRCBMT1 ;WISC@ALTOONA/CLH-MULTIPLE TRANS CON'T ;10-3-89/2:09 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4REVIEW ;REVIEW DATA BEFORE POSTING
5 I '$D(PRCB("ASK")) S %A="Do you want to review this transaction",%B="",%=1 D ^PRCFYN S:%<0 PRCB("^")="" Q:%'=1
6 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
7EDIT 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
8 K PRCB("ASK") S DA=PRCB("TDA"),DIE="^PRCF(421.1,",DR="[PRCB ENTER TRANS]" D ^DIE K DIE D REVIEW
9OUT K DIC,TO,FR,BY,L,FLDS Q
10NOTE S X="Make note of this transaction number: "_PRCB("TN")_" and use for editing/posting at later time." D MSG^PRCFQ Q
11PST 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
12 . D VERI^PRCBMT
13 . I $D(PRCB("ERR")) W !,$C(7)," Required data missing in this transaction" S %=2 K PRCB("ERR")
14 . QUIT
15 S %A="Do you want to edit this transaction",%B="",%=1 D ^PRCFYN I %<0 S PRCB("^")=""
16 I %'=1 D NOTE Q
17 S PRCB("ASK")="" D EDIT
18 I PRCB("NOFLG")=1 Q
19 G PST
20 ;
21EN1 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
22 S NXT=0 F I=1:1 S NXT=$O(^PRCF(421.1,PRCB("TDA"),1,NXT)) Q:'NXT D GETTRAN
23 I LOCKFLG'=1 S X=" <Transfer to Fund Distribution File Completed.>*" D MSG^PRCFQ W ! S PRCB("AUTOKILL")=""
24 D DEL^PRCBMT,OUT^PRCBMT
25 Q
26GETTRAN ;GET TRANSACTION NUMBER AND POST DATA IN 421
27 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
28 S X=PRCB("TRANS"),DIC="^PRCF(421,",DLAYGO=421,DIC(0)="LOX" D ^DIC I $P(Y,"^",3)'=1 G GETTRAN
29 S PRCB("PDA")=+Y,LOCKFLG=0
30 L +^PRCF(421,PRCB("PDA")):5
31 E D EN^DDIOL("File in use by another user. Please try later.") S LOCKFLG=1 QUIT
32 L +^PRCF(421.1,PRCB("TDA")):10
33 E D EN^DDIOL("File in use. Please try later.") L -^PRCF(421,PRCB("PDA")) S LOCKFLG=1 QUIT
34 S TOREC=^PRCF(421,PRCB("PDA"),0)
35 S FREC(0)=^PRCF(421.1,PRCB("TDA"),1,NXT,0)
36 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)
37 F I=2:1:5 S $P(TOREC,"^",I+5)=$P(FREC(0),"^",I)
38 W !!,$P(FREC(0),U)," Filed with transaction number ",PRCB("TRANS")
39 S I=$$ACC^PRC0C(PRC("SITE"),$P(TOREC,U,2)_U_PRC("FY")_U_PRC("BBFY"))
40 S $P(TOREC,"^",16)=PRCF("SIFY")_"-"_$P(I,U,11)_"-"_$P(I,U,5)_"-"_$P(I,U,2)
41 S $P(TOREC,"^",20)="0"
42 S ^PRCF(421,PRCB("PDA"),0)=TOREC,%X="^PRCF(421.1,"_PRCB("TDA")_",2,",%Y="^PRCF(421,"_PRCB("PDA")_",1," D %XY^%RCR
43 S ^PRCF(421,PRCB("PDA"),4)="0^0^0^0^"_$P(^PRCF(421.1,PRCB("TDA"),1,NXT,4),"^",5,6)
44 S ^PRCF(421,"AL",PRCF("SIFY"),0,PRCB("PDA"))="",^PRCF(421,"AC",PRCF("SIFY")_"-"_+FREC(0),PRCB("PDA"))=""
45 L -^PRCF(421,PRCB("PDA")),-^PRCF(421.1,PRCB("TDA"))
46 Q
Note: See TracBrowser for help on using the repository browser.