RMPRSP2 ;PHX/RFM-PRINT SUSPENSE STATISTICS ;8/29/1994
;;3.0;PROSTHETICS;**45,52,77**;Feb 09, 1996
;
; ODJ - patch 52 - ensure report does not include records prior to
; 10/05/00 today.
;
; ODJ - patch 52 - ensure cancelled records are excluded from stats.
; 10/05/00
; RVD 3/17/03 patch #77 - allow queing to p-message. IO to ION
;
K ^TMP($J)
D DIV4^RMPRSIT G:$D(X) EXIT1 D HOME^%ZIS S %DT="AEX",%DT("A")="Starting Date: " D ^%DT G:Y<1 EXIT1 S RMPRBDT=Y
S %DT(0)=Y,%DT("A")="Ending Date: " D ^%DT K %DT G:Y<1 EXIT1 S RMPREDT=Y
S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
I '$D(IO("Q")) U IO G PRINT
K IO("Q") S ZTDESC="PROSTHETIC SUSPENSE STATISTICS",ZTRTN="PRINT^RMPRSP2",ZTIO=ION,ZTSAVE("RMPRBDT")="",ZTSAVE("RMPREDT")="",ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMPRSITE")=""
D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
PRINT W:$E(IOST)["C" @IOF S RMPRPAGE=1 F I=1:1:11 S (CFOT(I),OFOT(I))=0
S RB=RMPRBDT,(RO,OTOT,CTOT,ITOT,DELDAT,J1,ODELDAT)=0 ;patch 52
S:$D(^RMPR(668,"B",RB)) RB=$O(^RMPR(668,"B",RB),-1) ;patch 52
C F S RB=$O(^RMPR(668,"B",RB)) Q:$P(RB,".",1)>RMPREDT!(RB'>0) F S RO=$O(^RMPR(668,"B",RB,RO)) Q:RO="" D CK
G WRI
CK Q:$P(RB,".",1)<RMPRBDT ;patch 52
Q:'$D(^RMPR(668,RO,0)) Q:$P(^(0),U,3)'>0!('+$P(^(0),U,2)) I RMPRSITE'=1,$P(^(0),U,7)'=RMPR("STA") Q
I RMPRSITE=1,$P(^RMPR(668,RO,0),U,7)'="",$P(^(0),U,7)'=RMPR("STA") Q
Q:$P(^RMPR(668,RO,0),U,10)="X" ;patch 52
S ^TMP($J,$P(^RMPR(668,RO,0),U),RO)=""
Q
WRI ;
S RP=0,RQ=0
F S RP=$O(^TMP($J,RP)) Q:RP="" F S RQ=$O(^TMP($J,RP,RQ)) Q:RQ="" D CALC
;
I '$D(^TMP($J)) D
. S Y=DT D DD^%DT W !,Y,?25,"PROSTHETICS SUSPENSE STATISTICS"_" STA ",$$STA^RMPRUTIL
. W !!,"No statistics available for this period!" S RMPREX=1
G:$D(RMPREX) EXIT1
LINE W !?15,"Prosthetics Suspense Statistics "
N X,Y,% D NOW^%DTC S Y=% D DD^%DT S Y=$TR(Y,"@"," ") W $P(Y,":",1,2)
W !?16,"For The Period "
;W !,"PROSTHETICS SUSPENSE STATISTICS FOR THE PERIOD "
S Y=RMPRBDT D DD^%DT W Y S Y=RMPREDT D DD^%DT
W "-"_Y_" STA "_$$STA^RMPRUTIL
W !,"OPEN SUSPENSE RECORDS" S RX="O"
W !,"PSC",?5,"2421",?11,"2237",?17,"2529-3",?25,"2529-7",?33,"2474",?39,"2431",?45,"2914",?51,"OTHER",?58,"2520",?64,"STK ISU"
W !,$J(OFOT(1),3),?5,$J(OFOT(2),4),?11,$J(OFOT(3),4),?17,$J(OFOT(4),6),?25,$J(OFOT(5),6),?33,$J(OFOT(6),4),?39,$J(OFOT(7),4),?45,$J(OFOT(8),4),?51,$J(OFOT(9),5),?58,$J(OFOT(10),4),?64,$J(OFOT(11),7)
;init action is pending not open
S RO=0 F S RO=$O(OFOT(RO)) Q:RO="" S OTOT=OTOT+OFOT(RO)
;
W !!,"CLOSED SUSPENSE RECORDS"
W !,"PSC",?5,"2421",?11,"2237",?17,"2529-3",?25,"2529-7"
W ?33,"2474",?39,"2431",?45,"2914",?51,"OTHER",?58,"2520"
W ?64,"STK ISU"
W !,$J(CFOT(1),3),?5,$J(CFOT(2),4),?11,$J(CFOT(3),4),?17
W $J(CFOT(4),6),?25,$J(CFOT(5),6),?33,$J(CFOT(6),4),?39
W $J(CFOT(7),4),?45,$J(CFOT(8),4),?51,$J(CFOT(9),5),?58
W $J(CFOT(10),4),?64,$J(CFOT(11),7)
;
TOT1 ;
N RO
S RO=0
F S RO=$O(CFOT(RO)) Q:RO="" S CTOT=CTOT+CFOT(RO)
;
W !!,"NUMBER INITIAL ACTION AFTER 5 DAYS: ",DELDAT
;
W !,"PERCENT OF DELIQUENT RECORDS: "
I DELDAT>0 W DELDAT/CTOT*100\1_"%"
E W "NONE"
;
W !,"NUMBER OF DELIQUENT OPEN RECORDS: ",ODELDAT W ?42,"PERCENT: " I ODELDAT>0 W $FN(ODELDAT/OTOT*100,"P",1)
W !!,"TOTAL CLOSED RECORDS: ",CTOT
W !,"TOTAL PENDING RECORDS: ",ITOT
W !,"TOTAL OPEN RECORDS: ",OTOT
W !!,"TOTAL RECORDS: ",CTOT+OTOT+ITOT
W !!,"OVERALL PERCENT OF RECORDS BY FORM TYPE",?73,"ERROR"
;
S CALC="S FTOT=CTOT+OTOT+ITOT,FTOT=$S(FTOT=0:0,1:$J(TTOT/FTOT*100,1,1))"
F I=(OFOT(1)+CFOT(1)),(OFOT(2)+CFOT(2)),(OFOT(3)+CFOT(3)),(OFOT(4)+CFOT(4)),(OFOT(5)+CFOT(5)),(OFOT(6)+CFOT(6)),(OFOT(7)+CFOT(7)),(OFOT(8)+CFOT(8)),(OFOT(9)+CFOT(9)),(OFOT(10)+CFOT(10)),(OFOT(11)+CFOT(11)) D PCAL
;
W !,"PSC",?5,"2421",?11,"2237",?17,"2529-3",?25,"2529-7",?33
W "2474",?39,"2431",?45,"2914",?51,"OTHER",?58,"2520"
W ?64,"STK ISU",?73,"MARGIN"
W !,RTOT(1),?5,RTOT(2),?11,$J(RTOT(3),4),?17,$J(RTOT(4),6)
W ?25,$J(RTOT(5),6),?33,$J(RTOT(6),4),?39,$J(RTOT(7),4)
W ?45,$J(RTOT(8),4),?51,$J(RTOT(9),5),?58,$J(RTOT(10),4)
W ?64,$J(RTOT(11),7)
N RO,MARERR
S RO=0,MARERR=0
F S RO=$O(RTOT(RO)) Q:RO="" S MARERR=MARERR+RTOT(RO)
W ?74,100-MARERR_"%"
G ASK1
;
PCAL S TTOT=I,J1=(J1+1) X CALC S RTOT(J1)=FTOT Q
;
ASK1 I $E(IOST)["C" K DIR S DIR(0)="E" D ^DIR G:Y<1 EXIT1
I $D(NAME) W:$Y>(IOSL-4) @IOF W !!,"RECORDS CLOSED BY PROSTHETICS AGENT",! S RO=0 F S RO=$O(NAME(RO)) Q:RO="" W !,RO,?30,$P(NAME(RO),U)
I $D(NAME),$E(IOST)["C" W !! D ^DIR
EXIT1 ;common exit
K FO,I,J1,MARERR,MART,RMPRBDT,RX,TTOT,ITOT,TOT,FOT,OFOT,CALC,DELDAT
K ODELDAT,FTOT,CTOT,OTOT,CFOT,RTOT,RMPREDT,RMPRFLG,RMPRFL,RMPREND
K RMPRPAGE,RMPRG,X,Y,RMPRFORM,DIR,RP,RS,RQ,RO,RB,RZ,RMPRFOR1,RMPREX
K ^TMP($J),RP,RR,RMPRFOR2,NAME,DIR
D ^%ZISC
Q
;
CALC S FO=$P(^RMPR(668,RQ,0),U,3)
I $P(^RMPR(668,RQ,0),U,5) S $P(CFOT(FO),U)=$P(CFOT(FO),U)+1,X2=$P(^(0),U),X1=$P(^(0),U,9) D ^%DTC I X>7 S DELDAT=DELDAT+1
;pending total
I ($P(^RMPR(668,RQ,0),U,9))&($P(^RMPR(668,RQ,0),U,5)="") S ITOT=ITOT+1
;
I $P(^RMPR(668,RQ,0),U,9),$D(^VA(200,+$P(^RMPR(668,RQ,0),U,6),0)) S:'$D(NAME($P(^(0),U))) NAME($P(^(0),U))="" S $P(NAME($P(^(0),U)),U)=$P(NAME($P(^(0),U)),U)+1
I '$P(^RMPR(668,RQ,0),U,9) S $P(OFOT(FO),U)=$P(OFOT(FO),U)+1 S X2=$P(^RMPR(668,RQ,0),U),X1=DT D ^%DTC I X>7 S ODELDAT=ODELDAT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRSP2 5382 printed Nov 22, 2024@17:47:47 Page 2
RMPRSP2 ;PHX/RFM-PRINT SUSPENSE STATISTICS ;8/29/1994
+1 ;;3.0;PROSTHETICS;**45,52,77**;Feb 09, 1996
+2 ;
+3 ; ODJ - patch 52 - ensure report does not include records prior to
+4 ; 10/05/00 today.
+5 ;
+6 ; ODJ - patch 52 - ensure cancelled records are excluded from stats.
+7 ; 10/05/00
+8 ; RVD 3/17/03 patch #77 - allow queing to p-message. IO to ION
+9 ;
+10 KILL ^TMP($JOB)
+11 DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT1
DO HOME^%ZIS
SET %DT="AEX"
SET %DT("A")="Starting Date: "
DO ^%DT
if Y<1
GOTO EXIT1
SET RMPRBDT=Y
+12 SET %DT(0)=Y
SET %DT("A")="Ending Date: "
DO ^%DT
KILL %DT
if Y<1
GOTO EXIT1
SET RMPREDT=Y
+13 SET %ZIS="MQ"
KILL IOP
DO ^%ZIS
if POP
GOTO EXIT1
+14 IF '$DATA(IO("Q"))
USE IO
GOTO PRINT
+15 KILL IO("Q")
SET ZTDESC="PROSTHETIC SUSPENSE STATISTICS"
SET ZTRTN="PRINT^RMPRSP2"
SET ZTIO=ION
SET ZTSAVE("RMPRBDT")=""
SET ZTSAVE("RMPREDT")=""
SET ZTSAVE("RMPR(""STA"")")=""
SET ZTSAVE("RMPRSITE")=""
+16 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"REQUEST QUEUED!"
HANG 1
GOTO EXIT1
PRINT if $EXTRACT(IOST)["C"
WRITE @IOF
SET RMPRPAGE=1
FOR I=1:1:11
SET (CFOT(I),OFOT(I))=0
+1 ;patch 52
SET RB=RMPRBDT
SET (RO,OTOT,CTOT,ITOT,DELDAT,J1,ODELDAT)=0
+2 ;patch 52
if $DATA(^RMPR(668,"B",RB))
SET RB=$ORDER(^RMPR(668,"B",RB),-1)
C FOR
SET RB=$ORDER(^RMPR(668,"B",RB))
if $PIECE(RB,".",1)>RMPREDT!(RB'>0)
QUIT
FOR
SET RO=$ORDER(^RMPR(668,"B",RB,RO))
if RO=""
QUIT
DO CK
+1 GOTO WRI
CK ;patch 52
if $PIECE(RB,".",1)<RMPRBDT
QUIT
+1 if '$DATA(^RMPR(668,RO,0))
QUIT
if $PIECE(^(0),U,3)'>0!('+$PIECE(^(0),U,2))
QUIT
IF RMPRSITE'=1
IF $PIECE(^(0),U,7)'=RMPR("STA")
QUIT
+2 IF RMPRSITE=1
IF $PIECE(^RMPR(668,RO,0),U,7)'=""
IF $PIECE(^(0),U,7)'=RMPR("STA")
QUIT
+3 ;patch 52
if $PIECE(^RMPR(668,RO,0),U,10)="X"
QUIT
+4 SET ^TMP($JOB,$PIECE(^RMPR(668,RO,0),U),RO)=""
+5 QUIT
WRI ;
+1 SET RP=0
SET RQ=0
+2 FOR
SET RP=$ORDER(^TMP($JOB,RP))
if RP=""
QUIT
FOR
SET RQ=$ORDER(^TMP($JOB,RP,RQ))
if RQ=""
QUIT
DO CALC
+3 ;
+4 IF '$DATA(^TMP($JOB))
Begin DoDot:1
+5 SET Y=DT
DO DD^%DT
WRITE !,Y,?25,"PROSTHETICS SUSPENSE STATISTICS"_" STA ",$$STA^RMPRUTIL
+6 WRITE !!,"No statistics available for this period!"
SET RMPREX=1
End DoDot:1
+7 if $DATA(RMPREX)
GOTO EXIT1
LINE WRITE !?15,"Prosthetics Suspense Statistics "
+1 NEW X,Y,%
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET Y=$TRANSLATE(Y,"@"," ")
WRITE $PIECE(Y,":",1,2)
+2 WRITE !?16,"For The Period "
+3 ;W !,"PROSTHETICS SUSPENSE STATISTICS FOR THE PERIOD "
+4 SET Y=RMPRBDT
DO DD^%DT
WRITE Y
SET Y=RMPREDT
DO DD^%DT
+5 WRITE "-"_Y_" STA "_$$STA^RMPRUTIL
+6 WRITE !,"OPEN SUSPENSE RECORDS"
SET RX="O"
+7 WRITE !,"PSC",?5,"2421",?11,"2237",?17,"2529-3",?25,"2529-7",?33,"2474",?39,"2431",?45,"2914",?51,"OTHER",?58,"2520",?64,"STK ISU"
+8 WRITE !,$JUSTIFY(OFOT(1),3),?5,$JUSTIFY(OFOT(2),4),?11,$JUSTIFY(OFOT(3),4),?17,$JUSTIFY(OFOT(4),6),?25,$JUSTIFY(OFOT(5),6),?33,$JUSTIFY(OFOT(6),4),?39,$JUSTIFY(OFOT(7),4),?45,$JUSTIFY(OFOT(8),4),?51,$JUSTIFY(OFOT(9),5),?58,...
... $JUSTIFY(OFOT(10),4),?64,$JUSTIFY(OFOT(11),7)
+9 ;init action is pending not open
+10 SET RO=0
FOR
SET RO=$ORDER(OFOT(RO))
if RO=""
QUIT
SET OTOT=OTOT+OFOT(RO)
+11 ;
+12 WRITE !!,"CLOSED SUSPENSE RECORDS"
+13 WRITE !,"PSC",?5,"2421",?11,"2237",?17,"2529-3",?25,"2529-7"
+14 WRITE ?33,"2474",?39,"2431",?45,"2914",?51,"OTHER",?58,"2520"
+15 WRITE ?64,"STK ISU"
+16 WRITE !,$JUSTIFY(CFOT(1),3),?5,$JUSTIFY(CFOT(2),4),?11,$JUSTIFY(CFOT(3),4),?17
+17 WRITE $JUSTIFY(CFOT(4),6),?25,$JUSTIFY(CFOT(5),6),?33,$JUSTIFY(CFOT(6),4),?39
+18 WRITE $JUSTIFY(CFOT(7),4),?45,$JUSTIFY(CFOT(8),4),?51,$JUSTIFY(CFOT(9),5),?58
+19 WRITE $JUSTIFY(CFOT(10),4),?64,$JUSTIFY(CFOT(11),7)
+20 ;
TOT1 ;
+1 NEW RO
+2 SET RO=0
+3 FOR
SET RO=$ORDER(CFOT(RO))
if RO=""
QUIT
SET CTOT=CTOT+CFOT(RO)
+4 ;
+5 WRITE !!,"NUMBER INITIAL ACTION AFTER 5 DAYS: ",DELDAT
+6 ;
+7 WRITE !,"PERCENT OF DELIQUENT RECORDS: "
+8 IF DELDAT>0
WRITE DELDAT/CTOT*100\1_"%"
+9 IF '$TEST
WRITE "NONE"
+10 ;
+11 WRITE !,"NUMBER OF DELIQUENT OPEN RECORDS: ",ODELDAT
WRITE ?42,"PERCENT: "
IF ODELDAT>0
WRITE $FNUMBER(ODELDAT/OTOT*100,"P",1)
+12 WRITE !!,"TOTAL CLOSED RECORDS: ",CTOT
+13 WRITE !,"TOTAL PENDING RECORDS: ",ITOT
+14 WRITE !,"TOTAL OPEN RECORDS: ",OTOT
+15 WRITE !!,"TOTAL RECORDS: ",CTOT+OTOT+ITOT
+16 WRITE !!,"OVERALL PERCENT OF RECORDS BY FORM TYPE",?73,"ERROR"
+17 ;
+18 SET CALC="S FTOT=CTOT+OTOT+ITOT,FTOT=$S(FTOT=0:0,1:$J(TTOT/FTOT*100,1,1))"
+19 FOR I=(OFOT(1)+CFOT(1)),(OFOT(2)+CFOT(2)),(OFOT(3)+CFOT(3)),(OFOT(4)+CFOT(4)),(OFOT(5)+CFOT(5)),(OFOT(6)+CFOT(6)),(OFOT(7)+CFOT(7)),(OFOT(8)+CFOT(8)),(OFOT(9)+CFOT(9)),(OFOT(10)+CFOT(10)),(OFOT(11)+CFOT(11))
DO PCAL
+20 ;
+21 WRITE !,"PSC",?5,"2421",?11,"2237",?17,"2529-3",?25,"2529-7",?33
+22 WRITE "2474",?39,"2431",?45,"2914",?51,"OTHER",?58,"2520"
+23 WRITE ?64,"STK ISU",?73,"MARGIN"
+24 WRITE !,RTOT(1),?5,RTOT(2),?11,$JUSTIFY(RTOT(3),4),?17,$JUSTIFY(RTOT(4),6)
+25 WRITE ?25,$JUSTIFY(RTOT(5),6),?33,$JUSTIFY(RTOT(6),4),?39,$JUSTIFY(RTOT(7),4)
+26 WRITE ?45,$JUSTIFY(RTOT(8),4),?51,$JUSTIFY(RTOT(9),5),?58,$JUSTIFY(RTOT(10),4)
+27 WRITE ?64,$JUSTIFY(RTOT(11),7)
+28 NEW RO,MARERR
+29 SET RO=0
SET MARERR=0
+30 FOR
SET RO=$ORDER(RTOT(RO))
if RO=""
QUIT
SET MARERR=MARERR+RTOT(RO)
+31 WRITE ?74,100-MARERR_"%"
+32 GOTO ASK1
+33 ;
PCAL SET TTOT=I
SET J1=(J1+1)
XECUTE CALC
SET RTOT(J1)=FTOT
QUIT
+1 ;
ASK1 IF $EXTRACT(IOST)["C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
if Y<1
GOTO EXIT1
+1 IF $DATA(NAME)
if $Y>(IOSL-4)
WRITE @IOF
WRITE !!,"RECORDS CLOSED BY PROSTHETICS AGENT",!
SET RO=0
FOR
SET RO=$ORDER(NAME(RO))
if RO=""
QUIT
WRITE !,RO,?30,$PIECE(NAME(RO),U)
+2 IF $DATA(NAME)
IF $EXTRACT(IOST)["C"
WRITE !!
DO ^DIR
EXIT1 ;common exit
+1 KILL FO,I,J1,MARERR,MART,RMPRBDT,RX,TTOT,ITOT,TOT,FOT,OFOT,CALC,DELDAT
+2 KILL ODELDAT,FTOT,CTOT,OTOT,CFOT,RTOT,RMPREDT,RMPRFLG,RMPRFL,RMPREND
+3 KILL RMPRPAGE,RMPRG,X,Y,RMPRFORM,DIR,RP,RS,RQ,RO,RB,RZ,RMPRFOR1,RMPREX
+4 KILL ^TMP($JOB),RP,RR,RMPRFOR2,NAME,DIR
+5 DO ^%ZISC
+6 QUIT
+7 ;
CALC SET FO=$PIECE(^RMPR(668,RQ,0),U,3)
+1 IF $PIECE(^RMPR(668,RQ,0),U,5)
SET $PIECE(CFOT(FO),U)=$PIECE(CFOT(FO),U)+1
SET X2=$PIECE(^(0),U)
SET X1=$PIECE(^(0),U,9)
DO ^%DTC
IF X>7
SET DELDAT=DELDAT+1
+2 ;pending total
+3 IF ($PIECE(^RMPR(668,RQ,0),U,9))&($PIECE(^RMPR(668,RQ,0),U,5)="")
SET ITOT=ITOT+1
+4 ;
+5 IF $PIECE(^RMPR(668,RQ,0),U,9)
IF $DATA(^VA(200,+$PIECE(^RMPR(668,RQ,0),U,6),0))
if '$DATA(NAME($PIECE(^(0),U)))
SET NAME($PIECE(^(0),U))=""
SET $PIECE(NAME($PIECE(^(0),U)),U)=$PIECE(NAME($PIECE(^(0),U)),U)+1
+6 IF '$PIECE(^RMPR(668,RQ,0),U,9)
SET $PIECE(OFOT(FO),U)=$PIECE(OFOT(FO),U)+1
SET X2=$PIECE(^RMPR(668,RQ,0),U)
SET X1=DT
DO ^%DTC
IF X>7
SET ODELDAT=ODELDAT+1
+7 QUIT
