PRCARFD3 ;WASH-ISC@ALTOONA,PA/LDB-LIST REFUNDS TO BE APPROVED ;8/19/94 3:03 PM
V ;;4.5;Accounts Receivable;;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;;
N D0,OUT,X,Y,STAT,POP
S %ZIS("A")="Select the output device: ",%ZIS="Q" D ^%ZIS Q:POP
I $D(IO("Q")) S ZTRTN="EN^PRCARFD3",ZTDESC="REFUNDS PENDING CERTIFYING OFFICIAL'S APPROVAL",ZTDTH=$H D ^%ZTLOAD Q
EN U IO
W:IOST?1"C".E @IOF
D HDR
S STAT=$O(^PRCA(430.3,"AC",113,0)) Q:'STAT
S D0=0 F S D0=$O(^PRCA(430,"AC",STAT,D0)),X="" Q:'D0!($D(OUT)) I $P($G(^PRCA(430,+D0,7)),"^",21)]"" W ! D ^PRCATRF W ! I ($Y+5)>IOSL D
.I $E(IOST)="C" R !,"Press Return to continue or ""^"" to exit ",X:DTIME I X="^"!'$T S OUT=1 Q
.I $O(^PRCA(430,"AC",STAT,D0)) W @IOF D HDR
D ^%ZISC Q
;
HDR W !?15,"REFUNDS PENDING CERTIFYING OFFICIAL'S APPROVAL",!
W !,"BILL NO.",?15,"PATIENT",?47,"REVIEWED DATE",?68,"AMOUNT",!,?47,"REVIEWED BY"
S X="",$P(X,"-",IOM)="" W !,X,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCARFD3 972 printed Dec 13, 2024@01:41:11 Page 2
PRCARFD3 ;WASH-ISC@ALTOONA,PA/LDB-LIST REFUNDS TO BE APPROVED ;8/19/94 3:03 PM
V ;;4.5;Accounts Receivable;;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;;
+3 NEW D0,OUT,X,Y,STAT,POP
+4 SET %ZIS("A")="Select the output device: "
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+5 IF $DATA(IO("Q"))
SET ZTRTN="EN^PRCARFD3"
SET ZTDESC="REFUNDS PENDING CERTIFYING OFFICIAL'S APPROVAL"
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
QUIT
EN USE IO
+1 if IOST?1"C".E
WRITE @IOF
+2 DO HDR
+3 SET STAT=$ORDER(^PRCA(430.3,"AC",113,0))
if 'STAT
QUIT
+4 SET D0=0
FOR
SET D0=$ORDER(^PRCA(430,"AC",STAT,D0))
SET X=""
if 'D0!($DATA(OUT))
QUIT
IF $PIECE($GET(^PRCA(430,+D0,7)),"^",21)]""
WRITE !
DO ^PRCATRF
WRITE !
IF ($Y+5)>IOSL
Begin DoDot:1
+5 IF $EXTRACT(IOST)="C"
READ !,"Press Return to continue or ""^"" to exit ",X:DTIME
IF X="^"!'$TEST
SET OUT=1
QUIT
+6 IF $ORDER(^PRCA(430,"AC",STAT,D0))
WRITE @IOF
DO HDR
End DoDot:1
+7 DO ^%ZISC
QUIT
+8 ;
HDR WRITE !?15,"REFUNDS PENDING CERTIFYING OFFICIAL'S APPROVAL",!
+1 WRITE !,"BILL NO.",?15,"PATIENT",?47,"REVIEWED DATE",?68,"AMOUNT",!,?47,"REVIEWED BY"
+2 SET X=""
SET $PIECE(X,"-",IOM)=""
WRITE !,X,!
+3 QUIT
