source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSREC4.m@ 1801

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

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1PRCSREC4 ;WISC/KMB-REPOST FILE 417.1 ENTRIES ;4/5/95 12:00
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;loop thru file 417.1 entries. try to reset 417.
5START ;
6 W !!,"This option attempts to repost FMS Exception file entries.",!,"Duplicate entries are not posted on the FMS Transactions file."
7 N COUNT S COUNT=$P($G(^PRCS(417.1,0)),"^",4) W !!,"There are ",+COUNT," transactions in your FMS Exceptions File.",!!
8 S %=1 W !!!,"Are you ready to begin" D YN^DICN Q:(%=2)!(%=-1) G:%=0 START
9 K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS Q:POP
10 I $D(IO("Q")) S ZTRTN="LOOP^PRCSREC4",ZTDESC="FMS REPOSTING REPORT" D ^%ZTLOAD,^%ZISC W !,"End of processing" Q
11 D LOOP,^%ZISC W !,"End of processing" QUIT
12LOOP ;
13 N A,B,AMT,ARRAY,II,FILE,FCP,FY,I,PODA,PONUM,PONUM1,QUARTER,RDA,STATION,STR,STRING,TDATE,TRANCODE,TRANSNUM,COUNTER,USER,X,Y,FLAG,TY,Z1,P
14 D NOW^%DTC S Y=% D DD^%DT S TY=Y
15 ;
16 S (FLAG,P,Z1)=0,STR=",,,FY,,FUND,AO,SITE,PGM,FCPRJ,,,,JOB,,OC"
17 S RDA=0 F S RDA=$O(^PRCS(417.1,RDA)) Q:(+RDA=0)!(Z1="^") D RESET
18 I FLAG=0 U IO W !,"No transactions were reposted."
19 QUIT
20RESET ;
21 S STRING=^PRCS(417.1,RDA,0)
22 F I=4,6,7,8,9,10,14,16 S ARRAY($P(STR,",",I))=$P(STRING,"^",I)
23 S STATION=ARRAY("SITE"),AMT=$P(STRING,"^",20),QUARTER=$P(STRING,"^",5),FY=$P(STRING,"^",4),TDATE=$P(STRING,"^",22),(PONUM,PONUM1)=$P(STRING,"^",18)
24 S ARRAY("BFY")=+$$YEAR^PRC0C($P(STRING,"^",2))
25 S TRANSNUM=$P(STRING,"^",17)_"-"_PONUM_"-"_$E(TDATE,2,7)_"-"_+$P(STRING,"^",19)_"-"_QUARTER
26 ;
27CHEC442 ;
28 S PODA=0,FCP="" S PONUM=$E(PONUM,4,9),PONUM=STATION_"-"_PONUM S:$D(^PRC(442,"B",PONUM)) PODA=$O(^PRC(442,"B",PONUM,0))
29 I +PODA'=0 S FCP=$P($G(^PRC(442,PODA,0)),"^",3),FCP=+$P(FCP," ") I $D(^PRC(420,STATION,1,FCP,4,FY)) G POST
30 ;
31 S A="" D FINDCP^PRCSREC Q:A=""
32 S B=$$FIRST^PRC0B1("^PRCD(420.141,""B"","""_A_""",",0) Q:'B
33 S FCP=+$P(^PRCD(420.141,B,0),"^",2) Q:+FCP=0
34 I '$D(^PRC(420,STATION,1,+FCP,4,FY)) Q
35 ;
36 ;
37POST ;
38 S TRANSNUM=TRANSNUM_"-"_FCP
39 Q:$D(^PRCS(417,"B",TRANSNUM))
40 S A=STATION_"^"_+FCP_"^"_FY_"^"_QUARTER_"^"_AMT D EBAL^PRCSEZ(A,"O")
41 S TRANCODE=$P(STRING,"^",17) I TRANCODE'="CC",$E(PONUM1,4,7)'?4A D EBAL^PRCSEZ(A,"C")
42 S X=TRANSNUM,DIC="^PRCS(417,",DIC(0)="LZ",DLAYGO=417 D ^DIC Q:Y=-1 S FMSDA=+Y K DIC
43 L +^PRCS(417,FMSDA):5 Q:'$T F I=2:1:20 S $P(^PRCS(417,FMSDA,0),"^",I)=$P(STRING,"^",I)
44 S $P(^PRCS(417,FMSDA,0),"^",22)=TDATE
45 S COUNTER=STATION_"-"_FY_"-"_QUARTER_"-"_FCP,$P(^PRCS(417,FMSDA,0),"^",21)=COUNTER,^PRCS(417,"C",COUNTER,FMSDA)=""
46 S $P(^PRCS(417,FMSDA,1),"^")=1
47 L -^PRCS(417,FMSDA) S FLAG=1 D:P=0 HDR
48 D:IOSL-$Y<3 HOLD Q:Z1="^"
49 U IO W !,TRANSNUM," posted to control point ",FCP,!,"for fiscal year ",FY,", quarter ",QUARTER," for $",AMT
50 S DA=RDA,DIK="^PRCS(417.1," D ^DIK K DA,DIK
51 QUIT
52 ;
53HOLD G HDR:$D(ZTQUEUED),HDR:IO'=IO(0) W !,"Press return to continue, uparrow (^) to exit: " R Z1:DTIME S:'$T Z1="^" D:Z1'="^" HDR Q
54 ;
55HDR S P=P+1,II="" U IO W !,"FMS REPOSTING REPORT",?30,TY,?60,"PAGE ",P S $P(II,"-",80)="-" W !,II
56 QUIT
Note: See TracBrowser for help on using the repository browser.