RCCPCT.m

RCCPCT ;WASH-ISC@ALTOONA,PA/LDB - CCPC Statements totals ;11/7/96  10:53 AM

V ;;4.5;Accounts Receivable;**34**;Mar 20, 1995;

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;;

EN ;Ask for device

 D HOME^%ZIS S %ZIS="AEQ" D ^%ZIS Q:POP

 I $D(IO("Q")) D  Q

 .S ZTRTN="START^RCCPCT",ZTDESC="CCPC PATIENT STATEMENT TOTAL REPORT"

 .;S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL_";"_$G(IO("DOC"))

 .D ^%ZTLOAD,^%ZISC

 .K ZTRTN,ZTDESC

 ;

START ;find all transmission record totals

 N DATE,PTOT,TTOT,X

 U IO S (TTOT,X)=0 F  S X=$O(^RCT(349,X)) Q:'X  I $D(^(X,0)) S TTOT=$P(^(0),"^",7)+TTOT

 S (PTOT,X)=0 F  S X=$O(^RCPS(349.2,X)) Q:'X  I $G(^(X,6)) S PTOT=PTOT+1

 S DATE=$O(^RCT(349,0)) S:DATE DATE=$G(^(DATE,0))

 I DATE]"" S DATE=$P(DATE,"^",9),DATE=$E(DATE,1,2)_"/"_$E(DATE,3,4)_"/"_$E(DATE,5,8)

 E  S DATE="N/A (NO TRANSMISSIONS)"

 I IOST?1"C".E W @IOF

 W !,?25,"CCPC Message Totals for ",DATE,!!

 W "Transmission Statement Total  : ",$J(TTOT,9)

 W !,"CCPC Statements Printed Total : ",$J(PTOT,9)

 W !!,"Total Not Printed             : ",$J(TTOT-PTOT,9)

 D ^%ZISC Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RCCPCT   1100     printed  Apr 09, 2024@20:53:09                                                                                                                                                                                                      Page 2

RCCPCT    ;WASH-ISC@ALTOONA,PA/LDB - CCPC Statements totals ;11/7/96  10:53 AM

V         ;;4.5;Accounts Receivable;**34**;Mar 20, 1995;

 +1       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +2       ;;

EN        ;Ask for device

 +1        DO HOME^%ZIS

           SET %ZIS="AEQ"

           DO ^%ZIS

           if POP

               QUIT 

 +2        IF $DATA(IO("Q"))

               Begin DoDot:1

 +3                SET ZTRTN="START^RCCPCT"

                   SET ZTDESC="CCPC PATIENT STATEMENT TOTAL REPORT"

 +4       ;S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL_";"_$G(IO("DOC"))

 +5                DO ^%ZTLOAD

                   DO ^%ZISC

 +6                KILL ZTRTN,ZTDESC

               End DoDot:1

               QUIT 

 +7       ;

START     ;find all transmission record totals

 +1        NEW DATE,PTOT,TTOT,X

 +2        USE IO

           SET (TTOT,X)=0

           FOR 

               SET X=$ORDER(^RCT(349,X))

               if 'X

                   QUIT 

               IF $DATA(^(X,0))

                   SET TTOT=$PIECE(^(0),"^",7)+TTOT

 +3        SET (PTOT,X)=0

           FOR 

               SET X=$ORDER(^RCPS(349.2,X))

               if 'X

                   QUIT 

               IF $GET(^(X,6))

                   SET PTOT=PTOT+1

 +4        SET DATE=$ORDER(^RCT(349,0))

           if DATE

               SET DATE=$GET(^(DATE,0))

 +5        IF DATE]""

               SET DATE=$PIECE(DATE,"^",9)

               SET DATE=$EXTRACT(DATE,1,2)_"/"_$EXTRACT(DATE,3,4)_"/"_$EXTRACT(DATE,5,8)

 +6       IF '$TEST

               SET DATE="N/A (NO TRANSMISSIONS)"

 +7        IF IOST?1"C".E

               WRITE @IOF

 +8        WRITE !,?25,"CCPC Message Totals for ",DATE,!!

 +9        WRITE "Transmission Statement Total  : ",$JUSTIFY(TTOT,9)

 +10       WRITE !,"CCPC Statements Printed Total : ",$JUSTIFY(PTOT,9)

 +11       WRITE !!,"Total Not Printed             : ",$JUSTIFY(TTOT-PTOT,9)

 +12       DO ^%ZISC

           QUIT