source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRSP2.m@ 719

Last change on this file since 719 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1RMPRSP2 ;PHX/RFM-PRINT SUSPENSE STATISTICS ;8/29/1994
2 ;;3.0;PROSTHETICS;**45,52,77**;Feb 09, 1996
3 ;
4 ; ODJ - patch 52 - ensure report does not include records prior to
5 ; 10/05/00 today.
6 ;
7 ; ODJ - patch 52 - ensure cancelled records are excluded from stats.
8 ; 10/05/00
9 ; RVD 3/17/03 patch #77 - allow queing to p-message. IO to ION
10 ;
11 K ^TMP($J)
12 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
13 S %DT(0)=Y,%DT("A")="Ending Date: " D ^%DT K %DT G:Y<1 EXIT1 S RMPREDT=Y
14 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
15 I '$D(IO("Q")) U IO G PRINT
16 K IO("Q") S ZTDESC="PROSTHETIC SUSPENSE STATISTICS",ZTRTN="PRINT^RMPRSP2",ZTIO=ION,ZTSAVE("RMPRBDT")="",ZTSAVE("RMPREDT")="",ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMPRSITE")=""
17 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
18PRINT W:$E(IOST)["C" @IOF S RMPRPAGE=1 F I=1:1:11 S (CFOT(I),OFOT(I))=0
19 S RB=RMPRBDT,(RO,OTOT,CTOT,ITOT,DELDAT,J1,ODELDAT)=0 ;patch 52
20 S:$D(^RMPR(668,"B",RB)) RB=$O(^RMPR(668,"B",RB),-1) ;patch 52
21C 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
22 G WRI
23CK Q:$P(RB,".",1)<RMPRBDT ;patch 52
24 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
25 I RMPRSITE=1,$P(^RMPR(668,RO,0),U,7)'="",$P(^(0),U,7)'=RMPR("STA") Q
26 Q:$P(^RMPR(668,RO,0),U,10)="X" ;patch 52
27 S ^TMP($J,$P(^RMPR(668,RO,0),U),RO)=""
28 Q
29WRI ;
30 S RP=0,RQ=0
31 F S RP=$O(^TMP($J,RP)) Q:RP="" F S RQ=$O(^TMP($J,RP,RQ)) Q:RQ="" D CALC
32 ;
33 I '$D(^TMP($J)) D
34 . S Y=DT D DD^%DT W !,Y,?25,"PROSTHETICS SUSPENSE STATISTICS"_" STA ",$$STA^RMPRUTIL
35 . W !!,"No statistics available for this period!" S RMPREX=1
36 G:$D(RMPREX) EXIT1
37LINE W !?15,"Prosthetics Suspense Statistics "
38 N X,Y,% D NOW^%DTC S Y=% D DD^%DT S Y=$TR(Y,"@"," ") W $P(Y,":",1,2)
39 W !?16,"For The Period "
40 ;W !,"PROSTHETICS SUSPENSE STATISTICS FOR THE PERIOD "
41 S Y=RMPRBDT D DD^%DT W Y S Y=RMPREDT D DD^%DT
42 W "-"_Y_" STA "_$$STA^RMPRUTIL
43 W !,"OPEN SUSPENSE RECORDS" S RX="O"
44 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"
45 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)
46 ;init action is pending not open
47 S RO=0 F S RO=$O(OFOT(RO)) Q:RO="" S OTOT=OTOT+OFOT(RO)
48 ;
49 W !!,"CLOSED SUSPENSE RECORDS"
50 W !,"PSC",?5,"2421",?11,"2237",?17,"2529-3",?25,"2529-7"
51 W ?33,"2474",?39,"2431",?45,"2914",?51,"OTHER",?58,"2520"
52 W ?64,"STK ISU"
53 W !,$J(CFOT(1),3),?5,$J(CFOT(2),4),?11,$J(CFOT(3),4),?17
54 W $J(CFOT(4),6),?25,$J(CFOT(5),6),?33,$J(CFOT(6),4),?39
55 W $J(CFOT(7),4),?45,$J(CFOT(8),4),?51,$J(CFOT(9),5),?58
56 W $J(CFOT(10),4),?64,$J(CFOT(11),7)
57 ;
58TOT1 ;
59 N RO
60 S RO=0
61 F S RO=$O(CFOT(RO)) Q:RO="" S CTOT=CTOT+CFOT(RO)
62 ;
63 W !!,"NUMBER INITIAL ACTION AFTER 5 DAYS: ",DELDAT
64 ;
65 W !,"PERCENT OF DELIQUENT RECORDS: "
66 I DELDAT>0 W DELDAT/CTOT*100\1_"%"
67 E W "NONE"
68 ;
69 W !,"NUMBER OF DELIQUENT OPEN RECORDS: ",ODELDAT W ?42,"PERCENT: " I ODELDAT>0 W $FN(ODELDAT/OTOT*100,"P",1)
70 W !!,"TOTAL CLOSED RECORDS: ",CTOT
71 W !,"TOTAL PENDING RECORDS: ",ITOT
72 W !,"TOTAL OPEN RECORDS: ",OTOT
73 W !!,"TOTAL RECORDS: ",CTOT+OTOT+ITOT
74 W !!,"OVERALL PERCENT OF RECORDS BY FORM TYPE",?73,"ERROR"
75 ;
76 S CALC="S FTOT=CTOT+OTOT+ITOT,FTOT=$S(FTOT=0:0,1:$J(TTOT/FTOT*100,1,1))"
77 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
78 ;
79 W !,"PSC",?5,"2421",?11,"2237",?17,"2529-3",?25,"2529-7",?33
80 W "2474",?39,"2431",?45,"2914",?51,"OTHER",?58,"2520"
81 W ?64,"STK ISU",?73,"MARGIN"
82 W !,RTOT(1),?5,RTOT(2),?11,$J(RTOT(3),4),?17,$J(RTOT(4),6)
83 W ?25,$J(RTOT(5),6),?33,$J(RTOT(6),4),?39,$J(RTOT(7),4)
84 W ?45,$J(RTOT(8),4),?51,$J(RTOT(9),5),?58,$J(RTOT(10),4)
85 W ?64,$J(RTOT(11),7)
86 N RO,MARERR
87 S RO=0,MARERR=0
88 F S RO=$O(RTOT(RO)) Q:RO="" S MARERR=MARERR+RTOT(RO)
89 W ?74,100-MARERR_"%"
90 G ASK1
91 ;
92PCAL S TTOT=I,J1=(J1+1) X CALC S RTOT(J1)=FTOT Q
93 ;
94ASK1 I $E(IOST)["C" K DIR S DIR(0)="E" D ^DIR G:Y<1 EXIT1
95 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)
96 I $D(NAME),$E(IOST)["C" W !! D ^DIR
97EXIT1 ;common exit
98 K FO,I,J1,MARERR,MART,RMPRBDT,RX,TTOT,ITOT,TOT,FOT,OFOT,CALC,DELDAT
99 K ODELDAT,FTOT,CTOT,OTOT,CFOT,RTOT,RMPREDT,RMPRFLG,RMPRFL,RMPREND
100 K RMPRPAGE,RMPRG,X,Y,RMPRFORM,DIR,RP,RS,RQ,RO,RB,RZ,RMPRFOR1,RMPREX
101 K ^TMP($J),RP,RR,RMPRFOR2,NAME,DIR
102 D ^%ZISC
103 Q
104 ;
105CALC S FO=$P(^RMPR(668,RQ,0),U,3)
106 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
107 ;pending total
108 I ($P(^RMPR(668,RQ,0),U,9))&($P(^RMPR(668,RQ,0),U,5)="") S ITOT=ITOT+1
109 ;
110 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
111 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
112 Q
Note: See TracBrowser for help on using the repository browser.