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 ---[H[J[2J[HRCCPCT 1100 printed Oct 16, 2024@17:44: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
