PRCARFD3.m

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 ---PRCARFD3   972     printed  Mar 13, 2025@20:45:52                                                                                                                                                                                                     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