| [613] | 1 | PRCF58A1 ;WISC@ALTOONA/CTB-1358 ADJUSTMENT CONT ;4/30/93 3:02 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D SCREEN S %A="Ok to continue",%B="",%=1 D ^PRCFYN I %'=1 G OUT
|
|---|
| 5 | S AMT=$P(TRNODE(4),"^",8)
|
|---|
| 6 | ;PRELOAD CODE SHEET
|
|---|
| 7 | S (OLDTT,X)=$E(^PRC(442,PRCFA("PODA"),10,1,0),1,6)
|
|---|
| 8 | K PRCFA("TT") I X="921.60" S PRCFA("TT")=$S(AMT<0:"921.33",1:"921.31") G K
|
|---|
| 9 | I X="921.10" S PRCFA("TT")=$S(AMT<0:"921.32",1:"921.30") G K
|
|---|
| 10 | I X="921.71" S PRCFA("TT")=$S(AMT<0:"921.73",1:"921.72")
|
|---|
| 11 | K S PRCFA("REF")=$P($P(PO(0),"^"),"-",2),PRCFA("SYS")="CLM" D TT^PRCFAC G:'% KILL D NEWCS^PRCFAC G:'$D(DA) KILL
|
|---|
| 12 | 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)_"^^"
|
|---|
| 13 | 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
|
|---|
| 14 | 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)
|
|---|
| 15 | S ^PRCF(423,PRCFA("CSDA"),1)=CS
|
|---|
| 16 | 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
|
|---|
| 17 | X ;UPDATE AMOUNTS IN 442
|
|---|
| 18 | S $P(PO(0),"^",15)=$P(PO(0),"^",15)+AMT,$P(PO(0),"^",11)=AMT
|
|---|
| 19 | F I=7,9 S $P(PO(0),"^",I)=$P(PO(0),"^",I)+$P(TRNODE(3),"^",I)
|
|---|
| 20 | F I=0 S ^PRC(442,PRCFA("PODA"),I)=PO(I)
|
|---|
| 21 | K PO S X=100,DA=PRCFA("PODA") D ENF^PRCHSTAT
|
|---|
| 22 | ;UPDATE ENTRY IN 410
|
|---|
| 23 | S DA=PRCFA("TRDA")
|
|---|
| 24 | D NOW^PRCFQ S TIME=X K %,%X
|
|---|
| 25 | S $P(^PRCS(410,PRCFA("TRDA"),10),"^",3,4)=PRCFA("PODA")_"^"
|
|---|
| 26 | S X=^PRCS(410,DA,4)
|
|---|
| 27 | S $P(X,"^",3,5)=AMT_"^"_TIME_"^"_$P($P(^PRC(442,PRCFA("PODA"),0),"^"),"-",2)
|
|---|
| 28 | S $P(X,"^",8)=AMT
|
|---|
| 29 | S ^PRCS(410,DA,4)=X
|
|---|
| 30 | S MESSAGE=""
|
|---|
| 31 | D ENCODE^PRCSC2(DA,DUZ,.MESSAGE)
|
|---|
| 32 | K MESSAGE
|
|---|
| 33 | S X=AMT
|
|---|
| 34 | S PRCHOBL="" D TRANK^PRCSES,TRANS^PRCSES K PRCHOBL D TRANS1^PRCSES K TIME
|
|---|
| 35 | ;POST ENTRY IN 424
|
|---|
| 36 | 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
|
|---|
| 37 | S PRCFA("424DA")=+Y D NOW^PRCFQ S DA=PRCFA("424DA"),X=PRCFA("PODA")_"^"_PRCFA("TRDA")_"^O^"_$P(TRNODE(4),"^",8)_"^"_%_"^OBLIGATION^^^^^^^ADJUSTMENT OBLIGATION"
|
|---|
| 38 | S $P(^PRC(424,DA,0),"^",2,14)=X,DIK="^PRC(424," D IX1^DIK K DIK
|
|---|
| 39 | S X=" ----DONE----*" D MSG^PRCFQ G OUT
|
|---|
| 40 | W Q
|
|---|
| 41 | SCREEN ;COMPARISON SCREEN
|
|---|
| 42 | D HILO^PRCFQ S CEILING=$P(PO(0),"^",15) W @IOF,IOINLOW,"Adjustment Transaction # ",IOINHI,$P(TRNODE(0),"^"),IOINLOW," 1358 # ",IOINHI,$P(PO(0),"^")
|
|---|
| 43 | W !!,IOINLOW,"Current amount obligated on 1358: ",IOINHI," $ ",$J(CEILING,0,2)
|
|---|
| 44 | S TBAL=$P(PO(8),"^"),TAUTH=CEILING-TBAL W !!,IOINLOW," Total Authorizations: ",IOINHI," $ ",$J(TAUTH,10,2)
|
|---|
| 45 | S LBAL=$P(PO(8),"^",2),LAUTH=CEILING-LBAL W ?40,IOINLOW," Total Liquidations: ",IOINHI," $ ",$J(LAUTH,10,2)
|
|---|
| 46 | W !,IOINLOW,"Authorization Balance: ",IOINHI," $ ",$J(TBAL,10,2),?40,IOINLOW,"Liquidation Balance: ",IOINHI," $ ",$J(LBAL,10,2),!!
|
|---|
| 47 | W IOINLOW,"Amount of Adjustment: ",IOINHI,$J($P(TRNODE(4),"^",8),0,2),!!,IOINORM K IOINHI,IOINLOW,IOINORM,LAUTH,TAUTH,TBAL,LBAL
|
|---|
| 48 | Q
|
|---|
| 49 | KILL Q
|
|---|
| 50 | 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
|
|---|
