| 1 | PRCSREC4 ;WISC/KMB-REPOST FILE 417.1 ENTRIES ;4/5/95 12:00
|
|---|
| 2 | V ;;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.
|
|---|
| 5 | START ;
|
|---|
| 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
|
|---|
| 12 | LOOP ;
|
|---|
| 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
|
|---|
| 20 | RESET ;
|
|---|
| 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 | ;
|
|---|
| 27 | CHEC442 ;
|
|---|
| 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 | ;
|
|---|
| 37 | POST ;
|
|---|
| 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 | ;
|
|---|
| 53 | HOLD 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 | ;
|
|---|
| 55 | HDR S P=P+1,II="" U IO W !,"FMS REPOSTING REPORT",?30,TY,?60,"PAGE ",P S $P(II,"-",80)="-" W !,II
|
|---|
| 56 | QUIT
|
|---|
