57 lines
2.9 KiB
Mathematica
57 lines
2.9 KiB
Mathematica
|
PRCSREC4 ;WISC/KMB-REPOST FILE 417.1 ENTRIES ;4/5/95 12:00
|
||
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
||
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
||
|
|
;loop thru file 417.1 entries. try to reset 417.
|
||
|
|
START ;
|
||
|
|
W !!,"This option attempts to repost FMS Exception file entries.",!,"Duplicate entries are not posted on the FMS Transactions file."
|
||
|
|
N COUNT S COUNT=$P($G(^PRCS(417.1,0)),"^",4) W !!,"There are ",+COUNT," transactions in your FMS Exceptions File.",!!
|
||
|
|
S %=1 W !!!,"Are you ready to begin" D YN^DICN Q:(%=2)!(%=-1) G:%=0 START
|
||
|
|
K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS Q:POP
|
||
|
|
I $D(IO("Q")) S ZTRTN="LOOP^PRCSREC4",ZTDESC="FMS REPOSTING REPORT" D ^%ZTLOAD,^%ZISC W !,"End of processing" Q
|
||
|
|
D LOOP,^%ZISC W !,"End of processing" QUIT
|
||
|
|
LOOP ;
|
||
|
|
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
|
||
|
|
D NOW^%DTC S Y=% D DD^%DT S TY=Y
|
||
|
|
;
|
||
|
|
S (FLAG,P,Z1)=0,STR=",,,FY,,FUND,AO,SITE,PGM,FCPRJ,,,,JOB,,OC"
|
||
|
|
S RDA=0 F S RDA=$O(^PRCS(417.1,RDA)) Q:(+RDA=0)!(Z1="^") D RESET
|
||
|
|
I FLAG=0 U IO W !,"No transactions were reposted."
|
||
|
|
QUIT
|
||
|
|
RESET ;
|
||
|
|
S STRING=^PRCS(417.1,RDA,0)
|
||
|
|
F I=4,6,7,8,9,10,14,16 S ARRAY($P(STR,",",I))=$P(STRING,"^",I)
|
||
|
|
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)
|
||
|
|
S ARRAY("BFY")=+$$YEAR^PRC0C($P(STRING,"^",2))
|
||
|
|
S TRANSNUM=$P(STRING,"^",17)_"-"_PONUM_"-"_$E(TDATE,2,7)_"-"_+$P(STRING,"^",19)_"-"_QUARTER
|
||
|
|
;
|
||
|
|
CHEC442 ;
|
||
|
|
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))
|
||
|
|
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
|
||
|
|
;
|
||
|
|
S A="" D FINDCP^PRCSREC Q:A=""
|
||
|
|
S B=$$FIRST^PRC0B1("^PRCD(420.141,""B"","""_A_""",",0) Q:'B
|
||
|
|
S FCP=+$P(^PRCD(420.141,B,0),"^",2) Q:+FCP=0
|
||
|
|
I '$D(^PRC(420,STATION,1,+FCP,4,FY)) Q
|
||
|
|
;
|
||
|
|
;
|
||
|
|
POST ;
|
||
|
|
S TRANSNUM=TRANSNUM_"-"_FCP
|
||
|
|
Q:$D(^PRCS(417,"B",TRANSNUM))
|
||
|
|
S A=STATION_"^"_+FCP_"^"_FY_"^"_QUARTER_"^"_AMT D EBAL^PRCSEZ(A,"O")
|
||
|
|
S TRANCODE=$P(STRING,"^",17) I TRANCODE'="CC",$E(PONUM1,4,7)'?4A D EBAL^PRCSEZ(A,"C")
|
||
|
|
S X=TRANSNUM,DIC="^PRCS(417,",DIC(0)="LZ",DLAYGO=417 D ^DIC Q:Y=-1 S FMSDA=+Y K DIC
|
||
|
|
L +^PRCS(417,FMSDA):5 Q:'$T F I=2:1:20 S $P(^PRCS(417,FMSDA,0),"^",I)=$P(STRING,"^",I)
|
||
|
|
S $P(^PRCS(417,FMSDA,0),"^",22)=TDATE
|
||
|
|
S COUNTER=STATION_"-"_FY_"-"_QUARTER_"-"_FCP,$P(^PRCS(417,FMSDA,0),"^",21)=COUNTER,^PRCS(417,"C",COUNTER,FMSDA)=""
|
||
|
|
S $P(^PRCS(417,FMSDA,1),"^")=1
|
||
|
|
L -^PRCS(417,FMSDA) S FLAG=1 D:P=0 HDR
|
||
|
|
D:IOSL-$Y<3 HOLD Q:Z1="^"
|
||
|
|
U IO W !,TRANSNUM," posted to control point ",FCP,!,"for fiscal year ",FY,", quarter ",QUARTER," for $",AMT
|
||
|
|
S DA=RDA,DIK="^PRCS(417.1," D ^DIK K DA,DIK
|
||
|
|
QUIT
|
||
|
|
;
|
||
|
|
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
|
||
|
|
;
|
||
|
|
HDR S P=P+1,II="" U IO W !,"FMS REPOSTING REPORT",?30,TY,?60,"PAGE ",P S $P(II,"-",80)="-" W !,II
|
||
|
|
QUIT
|