- PRCAUT2 ;SF-ISC/YJK-CALCULATE ADMIN. INTEREST AND CHECK NEW BILLS ;4/8/94 1:43 PM
- V ;;4.5;Accounts Receivable;**68**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- UPSTATS ;update current status
- Q:('$D(PRCABN))!('$D(PRCA("STATUS")))
- S $P(^PRCA(430,PRCABN,9),U,6)=$S($P(^PRCA(430,PRCABN,0),U,8)]"":$P(^(0),U,8),1:"")
- S DIE="^PRCA(430,",DA=PRCABN,DR="8////"_PRCA("STATUS")_";17////"_$G(DUZ) D ^DIE K DIE,DR
- Q
- COUNT ;count the number of returned bill to the service
- Q:'$D(DUZ) D SVC^PRCABIL Q:'$D(PRCAP("S"))
- S (PRCAK0,PRCAK)=0,PRCAKST=$O(^PRCA(430.3,"AC",205,"")),PRCAKM=" bill(s) pending approval." D CT1
- S (PRCAK0,PRCAK)=0,PRCAKST=$O(^PRCA(430.3,"AC",220,"")),PRCAKM=" bill(s) returned from Fiscal (New Bill)." D CT1
- S PRCAK=0,PRCAK0=0,PRCAKST=$O(^PRCA(430.3,"AC",230,"")),PRCAKM=" bill(s) returned from Fiscal for amendment." D CT1
- K PRCAK0,PRCAP,PRCAKST,PRCAKM Q
- CT1 F Z=0:0 S PRCAK=$O(^PRCA(430,"AC",PRCAKST,PRCAK)) Q:PRCAK'>0 I $D(^PRCA(430,PRCAK,100)),$P(^(100),U,2)=PRCAP("S") S PRCAK0=PRCAK0+1
- K PRCAK D:PRCAK0>0 CT2 K Z Q
- CT2 I PRCAK0=1 W !,*7,?5,"You have 1 ",PRCAKM Q
- I PRCAK0>1 W !,?5,"You have ",PRCAK0,PRCAKM Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAUT2 1195 printed Feb 18, 2025@23:08:25 Page 2
- PRCAUT2 ;SF-ISC/YJK-CALCULATE ADMIN. INTEREST AND CHECK NEW BILLS ;4/8/94 1:43 PM
- V ;;4.5;Accounts Receivable;**68**;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- UPSTATS ;update current status
- +1 if ('$DATA(PRCABN))!('$DATA(PRCA("STATUS")))
- QUIT
- +2 SET $PIECE(^PRCA(430,PRCABN,9),U,6)=$SELECT($PIECE(^PRCA(430,PRCABN,0),U,8)]"":$PIECE(^(0),U,8),1:"")
- +3 SET DIE="^PRCA(430,"
- SET DA=PRCABN
- SET DR="8////"_PRCA("STATUS")_";17////"_$GET(DUZ)
- DO ^DIE
- KILL DIE,DR
- +4 QUIT
- COUNT ;count the number of returned bill to the service
- +1 if '$DATA(DUZ)
- QUIT
- DO SVC^PRCABIL
- if '$DATA(PRCAP("S"))
- QUIT
- +2 SET (PRCAK0,PRCAK)=0
- SET PRCAKST=$ORDER(^PRCA(430.3,"AC",205,""))
- SET PRCAKM=" bill(s) pending approval."
- DO CT1
- +3 SET (PRCAK0,PRCAK)=0
- SET PRCAKST=$ORDER(^PRCA(430.3,"AC",220,""))
- SET PRCAKM=" bill(s) returned from Fiscal (New Bill)."
- DO CT1
- +4 SET PRCAK=0
- SET PRCAK0=0
- SET PRCAKST=$ORDER(^PRCA(430.3,"AC",230,""))
- SET PRCAKM=" bill(s) returned from Fiscal for amendment."
- DO CT1
- +5 KILL PRCAK0,PRCAP,PRCAKST,PRCAKM
- QUIT
- CT1 FOR Z=0:0
- SET PRCAK=$ORDER(^PRCA(430,"AC",PRCAKST,PRCAK))
- if PRCAK'>0
- QUIT
- IF $DATA(^PRCA(430,PRCAK,100))
- IF $PIECE(^(100),U,2)=PRCAP("S")
- SET PRCAK0=PRCAK0+1
- +1 KILL PRCAK
- if PRCAK0>0
- DO CT2
- KILL Z
- QUIT
- CT2 IF PRCAK0=1
- WRITE !,*7,?5,"You have 1 ",PRCAKM
- QUIT
- +1 IF PRCAK0>1
- WRITE !,?5,"You have ",PRCAK0,PRCAKM
- QUIT
- +2 QUIT