- PRCH58LQ ;WISC/CLH-1358 LIQUIDATIONS ;10/30/92 1:53 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- LIQ(PRCFA,Y,ER,PO) N DIC,Z,ZX,X
- S ER=1,DIC=442,DIC(0)="AMZEQ",DIC("A")="Select OBLIGATION NUMBER: ",DIC("S")="S Z=^(0) I +Z=PRC(""SITE""),$P(Z,U,2)=ZX",ZX=$O(^PRCD(442.5,"C",1358,0))
- K PRCFA("PODA") D ^DIC I Y<0 S ER=0 Q
- S PRCFA("PODA")=+Y,PRCFA("TRDA")=$P(Y(0),"^",12)
- F I=0,7,8,12 S PO(I)=$G(^PRC(442,PRCFA("PODA"),I))
- S:$D(^PRC(442,PRCFA("PODA"),7)) X=$P(^(7),"^",1)
- Q:$D(LOOK)
- I X=$O(^PRCD(442.3,"AC",40,0)) W $C(7),!!,"This 1358 transaction is complete. Transaction must be reactivated",!,"before additional posting may occur." Q:$D(PRCFA("XM")) S ER=0 Q
- I $O(^PRCD(442.3,"AC",+X,0))=$O(^PRCD(442.3,"AC",105,0)) W $C(7),!!,"This 1358 transaction has been cancelled.",!,"No posting is permitted." S ER=0 Q
- Q
- POST(PRCFA,LAMT,PO) ;post liquidated balance
- N OB,NB,DIE,DR,DA
- S OB=$P($G(^PRC(442,PRCFA("PODA"),8)),U,2),NB=OB+LAMT
- S DR="95////^S X=NB",DIE="^PRC(442,",DA=PRCFA("PODA") D ^DIE
- S PO(8)=^PRC(442,PRCFA("PODA"),8)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCH58LQ 1113 printed Feb 18, 2025@23:31:41 Page 2
- PRCH58LQ ;WISC/CLH-1358 LIQUIDATIONS ;10/30/92 1:53 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- LIQ(PRCFA,Y,ER,PO) NEW DIC,Z,ZX,X
- +1 SET ER=1
- SET DIC=442
- SET DIC(0)="AMZEQ"
- SET DIC("A")="Select OBLIGATION NUMBER: "
- SET DIC("S")="S Z=^(0) I +Z=PRC(""SITE""),$P(Z,U,2)=ZX"
- SET ZX=$ORDER(^PRCD(442.5,"C",1358,0))
- +2 KILL PRCFA("PODA")
- DO ^DIC
- IF Y<0
- SET ER=0
- QUIT
- +3 SET PRCFA("PODA")=+Y
- SET PRCFA("TRDA")=$PIECE(Y(0),"^",12)
- +4 FOR I=0,7,8,12
- SET PO(I)=$GET(^PRC(442,PRCFA("PODA"),I))
- +5 if $DATA(^PRC(442,PRCFA("PODA"),7))
- SET X=$PIECE(^(7),"^",1)
- +6 if $DATA(LOOK)
- QUIT
- +7 IF X=$ORDER(^PRCD(442.3,"AC",40,0))
- WRITE $CHAR(7),!!,"This 1358 transaction is complete. Transaction must be reactivated",!,"before additional posting may occur."
- if $DATA(PRCFA("XM"))
- QUIT
- SET ER=0
- QUIT
- +8 IF $ORDER(^PRCD(442.3,"AC",+X,0))=$ORDER(^PRCD(442.3,"AC",105,0))
- WRITE $CHAR(7),!!,"This 1358 transaction has been cancelled.",!,"No posting is permitted."
- SET ER=0
- QUIT
- +9 QUIT
- POST(PRCFA,LAMT,PO) ;post liquidated balance
- +1 NEW OB,NB,DIE,DR,DA
- +2 SET OB=$PIECE($GET(^PRC(442,PRCFA("PODA"),8)),U,2)
- SET NB=OB+LAMT
- +3 SET DR="95////^S X=NB"
- SET DIE="^PRC(442,"
- SET DA=PRCFA("PODA")
- DO ^DIE
- +4 SET PO(8)=^PRC(442,PRCFA("PODA"),8)
- +5 QUIT