PRCAUT3 ;SF-ISC/YJK-AR UTILITY ROUTINE ;11/19/96 10:28 AM
V ;;4.5;Accounts Receivable;**34,63,173**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
CTNEW ;count new bills. called by AR clerk's main menu.
I $P(^RC(342,1,0),"^",10)<DT W *7,!!,"WARNING!! The AR Package was last updated on: ",$$SLH^RCFN01($P(^RC(342,1,0),"^",10)),!,"*** Contact IRM Service!" H 5
D ^RCCPCBAK
I $O(^PRCA(430,"AC",+$O(^PRCA(430.3,"AC",104,0)),0)) W *7,!!,"*** You have NEW BILL(s) that need to be audited ***"
I $O(^PRCA(430,"AC",+$O(^PRCA(430.3,"AC",110,0)),0)) W *7,!!,"*** You have AMENDED BILL(s) that need to be audited ***"
I $O(^PRCA(430,"AC",+$O(^PRCA(430.3,"AC",113,0)),0)) W !!,*7,"*** You have PREPAYMENT BILL(s) that need to be reviewed for refund ***"
D ECHK^RCRCUTL
Q
Q:'$D(PRCABN)
;
I $G(PRAUTOA) D Q
. N PRCATEXT ; Stuff comment if auto-audit
. I $O(^PRCA(430,PRCABN,10,0)) S PRCATEXT(1)=" "
. S PRCATEXT($O(PRCATEXT(""),-1)+1)="*** AUTO-AUDITED BY ELECTRONIC RETURN MESSAGE RECEIPT "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
. D WP^DIE(430,PRCABN_",",10,"A","PRCATEXT")
;
S %=2 W !,"Do you want to write any comments for this bill " D YN^DICN I %<0 S PRCA("EXIT")="" Q
Q:%=2 I %=0 W !," You may add/edit comments to this word processing field for the bill." G COMMENTS
S DIE="^PRCA(430,",DR="98",DA=PRCABN D ^DIE K DR,DA,DIE,% Q
PRCOMM ;print the comments.
Q:('$D(D0))&('$D(PRCABN)) S PRCAD0=$S($D(PRCABN):PRCABN,1:D0) I '$D(^PRCA(430,PRCAD0,10)) G CANCL
W !,"COMMENTS:" S PRCAKN=0
F PRCAI=0:0 S PRCAKN=$O(^PRCA(430,PRCAD0,10,PRCAKN)) Q:'PRCAKN W !,?3,^(PRCAKN,0)
CANCL ;W ! S PRCAKSTA=$P(^PRCA(430,PRCAD0,0),U,8)
;I PRCAKSTA=$O(^PRCA(430.3,"AC",111,0)) W !,"CANCELLATION REMARKS: ",?13,$P(^PRCA(430,PRCAD0,0),U,15)
W ! K PRCAKN,PRCAI,PRCAD0,PRCAKSTA Q
CKSTAT ;Input transform for 430,8 (AR Current Status) - DA=Bill#
N Z1,Z2
S Z1=100,Z2=199 S:$D(PRCASV("STATUS")) Z1=199,Z2=300 S DIC("S")="I $P(^PRCA(430.3,Y,0),U,3)>Z1,$P(^(0),U,3)<Z2" S:$D(PRCAOLD) DIC("S")="I $P(^(0),U,5)=1" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X Q:'$D(X)
I $D(^PRCA(430.3,X,0)),$P(^(0),"^",3)'=102 Q
Q:",22,23,26,18,"[(","_$P(^PRCA(430,DA,0),U,2)_",") ;RX/MEANS NO PAT
;F Y=0:0 S Y=$O(^PRCA(430,DA,2,Y)) Q:'Y I $P(^(Y,0),"^",3)="" W *7,!!,"Fiscal Year ",+^(0)," for bill #",$P(^PRCA(430,DA,0),"^")," has no PAT ref #!",!,"A PAT ref # must be assigned to this FY before the bill",!,"can be made active.",! K X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAUT3 2508 printed Nov 22, 2024@16:52:15 Page 2
PRCAUT3 ;SF-ISC/YJK-AR UTILITY ROUTINE ;11/19/96 10:28 AM
V ;;4.5;Accounts Receivable;**34,63,173**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
CTNEW ;count new bills. called by AR clerk's main menu.
+1 IF $PIECE(^RC(342,1,0),"^",10)<DT
WRITE *7,!!,"WARNING!! The AR Package was last updated on: ",$$SLH^RCFN01($PIECE(^RC(342,1,0),"^",10)),!,"*** Contact IRM Service!"
HANG 5
+2 DO ^RCCPCBAK
+3 IF $ORDER(^PRCA(430,"AC",+$ORDER(^PRCA(430.3,"AC",104,0)),0))
WRITE *7,!!,"*** You have NEW BILL(s) that need to be audited ***"
+4 IF $ORDER(^PRCA(430,"AC",+$ORDER(^PRCA(430.3,"AC",110,0)),0))
WRITE *7,!!,"*** You have AMENDED BILL(s) that need to be audited ***"
+5 IF $ORDER(^PRCA(430,"AC",+$ORDER(^PRCA(430.3,"AC",113,0)),0))
WRITE !!,*7,"*** You have PREPAYMENT BILL(s) that need to be reviewed for refund ***"
+6 DO ECHK^RCRCUTL
+7 QUIT
+1 if '$DATA(PRCABN)
QUIT
+2 ;
+3 IF $GET(PRAUTOA)
Begin DoDot:1
+4 ; Stuff comment if auto-audit
NEW PRCATEXT
+5 IF $ORDER(^PRCA(430,PRCABN,10,0))
SET PRCATEXT(1)=" "
+6 SET PRCATEXT($ORDER(PRCATEXT(""),-1)+1)="*** AUTO-AUDITED BY ELECTRONIC RETURN MESSAGE RECEIPT "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
+7 DO WP^DIE(430,PRCABN_",",10,"A","PRCATEXT")
End DoDot:1
QUIT
+8 ;
+9 SET %=2
WRITE !,"Do you want to write any comments for this bill "
DO YN^DICN
IF %<0
SET PRCA("EXIT")=""
QUIT
+10 if %=2
QUIT
IF %=0
WRITE !," You may add/edit comments to this word processing field for the bill."
GOTO COMMENTS
+11 SET DIE="^PRCA(430,"
SET DR="98"
SET DA=PRCABN
DO ^DIE
KILL DR,DA,DIE,%
QUIT
PRCOMM ;print the comments.
+1 if ('$DATA(D0))&('$DATA(PRCABN))
QUIT
SET PRCAD0=$SELECT($DATA(PRCABN):PRCABN,1:D0)
IF '$DATA(^PRCA(430,PRCAD0,10))
GOTO CANCL
+2 WRITE !,"COMMENTS:"
SET PRCAKN=0
+3 FOR PRCAI=0:0
SET PRCAKN=$ORDER(^PRCA(430,PRCAD0,10,PRCAKN))
if 'PRCAKN
QUIT
WRITE !,?3,^(PRCAKN,0)
CANCL ;W ! S PRCAKSTA=$P(^PRCA(430,PRCAD0,0),U,8)
+1 ;I PRCAKSTA=$O(^PRCA(430.3,"AC",111,0)) W !,"CANCELLATION REMARKS: ",?13,$P(^PRCA(430,PRCAD0,0),U,15)
+2 WRITE !
KILL PRCAKN,PRCAI,PRCAD0,PRCAKSTA
QUIT
CKSTAT ;Input transform for 430,8 (AR Current Status) - DA=Bill#
+1 NEW Z1,Z2
+2 SET Z1=100
SET Z2=199
if $DATA(PRCASV("STATUS"))
SET Z1=199
SET Z2=300
SET DIC("S")="I $P(^PRCA(430.3,Y,0),U,3)>Z1,$P(^(0),U,3)<Z2"
if $DATA(PRCAOLD)
SET DIC("S")="I $P(^(0),U,5)=1"
DO ^DIC
KILL DIC
SET DIC=DIE
SET X=+Y
if Y<0
KILL X
if '$DATA(X)
QUIT
+3 IF $DATA(^PRCA(430.3,X,0))
IF $PIECE(^(0),"^",3)'=102
QUIT
+4 ;RX/MEANS NO PAT
if ",22,23,26,18,"[(","_$PIECE(^PRCA(430,DA,0),U,2)_",")
QUIT
+5 ;F Y=0:0 S Y=$O(^PRCA(430,DA,2,Y)) Q:'Y I $P(^(Y,0),"^",3)="" W *7,!!,"Fiscal Year ",+^(0)," for bill #",$P(^PRCA(430,DA,0),"^")," has no PAT ref #!",!,"A PAT ref # must be assigned to this FY before the bill",!,"can be made active.",! K X
+6 QUIT
