51 lines
3.2 KiB
Mathematica
51 lines
3.2 KiB
Mathematica
|
PRCF58A1 ;WISC@ALTOONA/CTB-1358 ADJUSTMENT CONT ;4/30/93 3:02 PM
|
||
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
||
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
||
|
|
D SCREEN S %A="Ok to continue",%B="",%=1 D ^PRCFYN I %'=1 G OUT
|
||
|
|
S AMT=$P(TRNODE(4),"^",8)
|
||
|
|
;PRELOAD CODE SHEET
|
||
|
|
S (OLDTT,X)=$E(^PRC(442,PRCFA("PODA"),10,1,0),1,6)
|
||
|
|
K PRCFA("TT") I X="921.60" S PRCFA("TT")=$S(AMT<0:"921.33",1:"921.31") G K
|
||
|
|
I X="921.10" S PRCFA("TT")=$S(AMT<0:"921.32",1:"921.30") G K
|
||
|
|
I X="921.71" S PRCFA("TT")=$S(AMT<0:"921.73",1:"921.72")
|
||
|
|
K S PRCFA("REF")=$P($P(PO(0),"^"),"-",2),PRCFA("SYS")="CLM" D TT^PRCFAC G:'% KILL D NEWCS^PRCFAC G:'$D(DA) KILL
|
||
|
|
S PRC("CP")=$P(TRNODE(0),"-",4),CS=$S($D(^PRCF(423,PRCFA("CSDA"),1)):^(1),1:""),$P(CS,"^")="..",$P(CS,"^",5,7)=PRC("CP")_"^"_+$P(PO(0),"^",5)_"^^"
|
||
|
|
F I=7,9 S AMT(I)=$P(TRNODE(3),"^",I) S:AMT(I)<0 AMT(I)=-AMT(I) S AMT(I)=AMT(I)*100
|
||
|
|
S $P(CS,"^",16)="$",$P(CS,"^",8,11)=+$P(TRNODE(3),"^",6)_"^"_AMT(7)_"^$^" I OLDTT'="921.60",+$P(TRNODE(3),"^",8)>0,AMT(9)>0 S $P(CS,"^",10,11)=$P(TRNODE(3),"^",8)_"^"_AMT(9)
|
||
|
|
S ^PRCF(423,PRCFA("CSDA"),1)=CS
|
||
|
|
Y D ^PRCFA921,^PRCFACXM I $D(PRCFDEL)!($D(PRCFA("CSHOLD"))) K PRCFDEL,PRCFA("CSHOLD") S X=" Code Sheet not Processed, No Further Action Taken.*" D MSG^PRCFQ G OUT
|
||
|
|
X ;UPDATE AMOUNTS IN 442
|
||
|
|
S $P(PO(0),"^",15)=$P(PO(0),"^",15)+AMT,$P(PO(0),"^",11)=AMT
|
||
|
|
F I=7,9 S $P(PO(0),"^",I)=$P(PO(0),"^",I)+$P(TRNODE(3),"^",I)
|
||
|
|
F I=0 S ^PRC(442,PRCFA("PODA"),I)=PO(I)
|
||
|
|
K PO S X=100,DA=PRCFA("PODA") D ENF^PRCHSTAT
|
||
|
|
;UPDATE ENTRY IN 410
|
||
|
|
S DA=PRCFA("TRDA")
|
||
|
|
D NOW^PRCFQ S TIME=X K %,%X
|
||
|
|
S $P(^PRCS(410,PRCFA("TRDA"),10),"^",3,4)=PRCFA("PODA")_"^"
|
||
|
|
S X=^PRCS(410,DA,4)
|
||
|
|
S $P(X,"^",3,5)=AMT_"^"_TIME_"^"_$P($P(^PRC(442,PRCFA("PODA"),0),"^"),"-",2)
|
||
|
|
S $P(X,"^",8)=AMT
|
||
|
|
S ^PRCS(410,DA,4)=X
|
||
|
|
S MESSAGE=""
|
||
|
|
D ENCODE^PRCSC2(DA,DUZ,.MESSAGE)
|
||
|
|
K MESSAGE
|
||
|
|
S X=AMT
|
||
|
|
S PRCHOBL="" D TRANK^PRCSES,TRANS^PRCSES K PRCHOBL D TRANS1^PRCSES K TIME
|
||
|
|
;POST ENTRY IN 424
|
||
|
|
Z S PO(0)=^PRC(442,PRCFA("PODA"),0),(X,Z)=$P(PO(0),"^"),%=1 D EN1^PRCSUT3 S DIC="^PRC(424,",DIC(0)="L",DLAYGO=424 D FILE^DICN K DLAYGO I Y<0 W !,"ERROR IN CREATING 424 RECORD",$C(7),!! Q
|
||
|
|
S PRCFA("424DA")=+Y D NOW^PRCFQ S DA=PRCFA("424DA"),X=PRCFA("PODA")_"^"_PRCFA("TRDA")_"^O^"_$P(TRNODE(4),"^",8)_"^"_%_"^OBLIGATION^^^^^^^ADJUSTMENT OBLIGATION"
|
||
|
|
S $P(^PRC(424,DA,0),"^",2,14)=X,DIK="^PRC(424," D IX1^DIK K DIK
|
||
|
|
S X=" ----DONE----*" D MSG^PRCFQ G OUT
|
||
|
|
W Q
|
||
|
|
SCREEN ;COMPARISON SCREEN
|
||
|
|
D HILO^PRCFQ S CEILING=$P(PO(0),"^",15) W @IOF,IOINLOW,"Adjustment Transaction # ",IOINHI,$P(TRNODE(0),"^"),IOINLOW," 1358 # ",IOINHI,$P(PO(0),"^")
|
||
|
|
W !!,IOINLOW,"Current amount obligated on 1358: ",IOINHI," $ ",$J(CEILING,0,2)
|
||
|
|
S TBAL=$P(PO(8),"^"),TAUTH=CEILING-TBAL W !!,IOINLOW," Total Authorizations: ",IOINHI," $ ",$J(TAUTH,10,2)
|
||
|
|
S LBAL=$P(PO(8),"^",2),LAUTH=CEILING-LBAL W ?40,IOINLOW," Total Liquidations: ",IOINHI," $ ",$J(LAUTH,10,2)
|
||
|
|
W !,IOINLOW,"Authorization Balance: ",IOINHI," $ ",$J(TBAL,10,2),?40,IOINLOW,"Liquidation Balance: ",IOINHI," $ ",$J(LBAL,10,2),!!
|
||
|
|
W IOINLOW,"Amount of Adjustment: ",IOINHI,$J($P(TRNODE(4),"^",8),0,2),!!,IOINORM K IOINHI,IOINLOW,IOINORM,LAUTH,TAUTH,TBAL,LBAL
|
||
|
|
Q
|
||
|
|
KILL Q
|
||
|
|
OUT K %,A,AMT,C,CS,CEILING,DA,DEL,DIK,DIC,DLAYGO,I,J,N1,N2,OLDTT,PO,PRCF,PRCFA,IOINORM,IOINHI,IOINLOW,TMP,TRNODE,X,X1,Y,Z Q
|