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