source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRSP1.m

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1RMPRSP1 ;PHX/RFM/HPL/HNC-PRINT 5 DAY OLD SUSPENSE RECORDS ;8/29/1994
2 ;;3.0;PROSTHETICS;**45,52,77**;Feb 09, 1996
3 ;
4 ; ODJ - patch 52 - 10/18/00 - fix undefined text line at EXT
5 ;RVD patch #77 - change IO to ION
6 ;
7 D DIV4^RMPRSIT G:$D(X) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
8 I '$D(IO("Q")) U IO G PRINT
9 K IO("Q") S ZTDESC="PRINT 5 DAY OLD SUSPENSE RECORDS",ZTRTN="PRINT^RMPRSP1",ZTIO=ION,ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMPRSITE")=""
10 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
11PRINT W:$E(IOST)["C-" @IOF S RMPRPAGE=1 F I=1:1:11 S FOT(I)=0,TOT=0
12C S RMPREDT=$$FMADD^XLFDT(DT,-7),RO=0,RB=$$FMADD^XLFDT(DT,-90) F S RB=$O(^RMPR(668,"B",RB)) Q:RB>RMPREDT!(RB'>0) F S RO=$O(^RMPR(668,"B",RB,RO)) Q:RO="" D CK
13 G WRI
14CK Q:'$D(^RMPR(668,RO,0))
15 Q:$P(^RMPR(668,RO,0),U,10)'="O"
16 Q:$P(^RMPR(668,RO,0),U,9)>0!($P(^(0),U)'>0)!($P(^(0),U,3)'>0)!('+$P(^(0),U,2))
17 Q:$P(^RMPR(668,RO,0),U,7)'=RMPR("STA")
18 S ^TMP($J,$P(^RMPR(668,RO,0),U),$P(^DPT($P(^RMPR(668,RO,0),U,2),0),U),$S($P(^(0),U,4)>0:$P(^(0),U,4),1:1),RO)=""
19 Q
20WRI ;
21 N RP,RQ,RZ,RS
22 S RP=0,RQ=0,RZ=0,RS=0
23 F S RP=$O(^TMP($J,RP)) Q:RP="" F S RQ=$O(^TMP($J,RP,RQ)) Q:RQ="" F S RS=$O(^TMP($J,RP,RQ,RS)) Q:RS="" F S RZ=$O(^TMP($J,RP,RQ,RS,RZ)) Q:RZ=""!($D(RMPREND)) D WRI2
24 I $D(RMPREND) G EXIT1
25 ;
26 ;
27 I '$D(^TMP($J)) D
28 . S Y=DT D DD^%DT W !,Y,?25,"OVER 5 DAY OLD SUSPENSE REPORT"
29 . W !!,"No open suspense records over 5 days!" S RMPREX=1
30 I $D(RMPREX) K RMPREX G EXIT1
31 ;
32 W ! F I=1:1:79 W "-"
33 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",?74,"TOTAL"
34 W !,$J(FOT(1),3),?5,$J(FOT(2),4),?11,$J(FOT(3),4),?17,$J(FOT(4),6),?25,$J(FOT(5),6),?33,$J(FOT(6),4),?39,$J(FOT(7),4),?45,$J(FOT(8),4),?51,$J(FOT(9),5),?58,$J(FOT(10),4),?64,$J(FOT(11),7)
35 S RO=0
36 F S RO=$O(FOT(RO)) Q:RO="" S TOT=TOT+FOT(RO)
37 W ?74,$J(TOT,5)
38 I $E(IOST)["C-" W ! K DIR S DIR(0)="E" D ^DIR
39 ;
40EXIT1 ;common exit
41 K FO,I,TOT,FOT,RMPREDT,RMPRFLG,RMPRFL,RMPREND,RMPRPAGE,RMPRG,X,Y
42 K RMPRFORM,DIR,RP,RS,RQ,RO,RB,RZ,RMPRFOR1,^TMP($J),RP,RR,RMPRFOR2
43 D ^%ZISC
44 Q
45 ;
46WRI2 I RMPRPAGE=1,'$D(RMPRFL) W:$Y>1 @IOF D HEADER1 Q:$D(RMPREND)
47 I $Y>(IOSL-6),$E(IOST)["C-",$D(RMPRFL) D HEADER Q:$D(RMPREND)
48 I $Y>(IOSL-6),$D(RMPRFL) W @IOF D HEADER1
49WRI3 ;
50 N DAT1
51 S DAT1=$$DAT1^RMPRUTL1(RP)
52 W !,DAT1,?13,$E($P(^DPT($P(^RMPR(668,RZ,0),U,2),0),U),1,20),?35,$E($P(^(0),U,9),6,9)
53 D FORM
54 W ?59,$S($D(^VA(200,+$P(^RMPR(668,RZ,0),U,4),0)):$E($P(^VA(200,$P(^RMPR(668,RZ,0),U,4),0),U),1,19),1:"NO NAME AVAILABLE")
55 S RMPRFL=1
56 Q:$D(RMPREND)
57 D:$D(^RMPR(668,RZ,2,0)) EXT
58 Q
59HEADER ;
60 W !
61 S DIR(0)="E" D ^DIR K DIR
62 I Y=""!(Y=0) S RMPREND=1 Q:Y=""!(Y=0)
63 W @IOF
64 ;
65HEADER1 ;
66 Q:$D(RMPREND)
67 S RMPRFL=1
68 W !,?23,"DELINQUENT OPEN SUSPENSE REPORT",?70,"STA ",$$STA^RMPRUTIL,!,?2,"DATE",?18,"PATIENT",?35,"SSN",?41,"FORM",?59,"SUSPENDED BY",?73,"PAGE ",RMPRPAGE,!
69 S RMPRPAGE=RMPRPAGE+1
70 I $D(RMPRFLG) W !,"CON'T" K RMPRFLG
71 Q
72 ;
73EXT ;display only the first line of description
74 ;modified in patch 52
75 N RR
76 S RR=$O(^RMPR(668,RZ,2,0))
77 W:+RR !,$G(^RMPR(668,RZ,2,RR,0))
78 ;display the entire description
79 ;N RR
80 ;S RR=0
81 ;F S RR=$O(^RMPR(668,RZ,2,RR)) W:RR="" ! Q:RR=""!($D(RMPREND)) D PEXT
82 Q
83 ;
84PEXT ;
85 ;I $Y>(IOSL-6),$E(IOST)["C",$D(RMPRFL) S RMPRFLG=1 D HEADER Q:$D(RMPREND)
86 ;I $Y>(IOSL-6),$D(RMPRFL) W @IOF S RMPRFLG=1 D HEADER1
87 ;W !,$P(^RMPR(668,RZ,2,RR,0),U)
88 Q
89 ;
90FORM ;
91 S FO=$P(^RMPR(668,RZ,0),U,3)
92 W ?41,$S(FO=1:"PSC",FO=2:"2421",FO=3:"2237",FO=4:"2529-3",FO=5:"2529-7",FO=6:"2474",FO=7:"2431",FO=8:"2914",FO=9:"OTHER",FO=10:"2520",FO=11:"STOCK ISSUE",1:"UNK")
93 S $P(FOT(FO),U)=$P(FOT(FO),U)+1
94 Q
Note: See TracBrowser for help on using the repository browser.