source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRSP3.m@ 794

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1RMPRSP3 ;HINES/HNC; - Print Pending Suspense Records File 668 ;5-5-00
2 ;;3.0;PROSTHETICS;**45,55,77**;Feb 09, 1996
3 ; RVD 3/17/03 patch #77 - allow queing to p-message. IO to ION
4 ;
5 ;station from CPRS may not be the same as site params, can not filter
6 ;station is from duz(2), the division in file 200, or
7 ;default institution in kernel system parameters file 8989.3.
8 ;
9EN ;PRINT PENDING SUSPENSE
10 ;
11 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT
12 I '$D(IO("Q")) U IO G PRINT
13 K IO("Q") S ZTDESC="PRINT OPEN/PENDING SUMMARY SUSPENSE",ZTRTN="PRINT^RMPRSP3",ZTIO=ION
14 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
15 ;
16PRINT I '$D(IO("Q")) U IO
17 W:$E(IOST)["C" @IOF
18 S RMPRPAGE=1
19 K ^TMP($J)
20 ;
21ALL ;main sort logic
22 ;REQUIRED VARIABLES: RMPRPAGE - PAGE NUMBER
23 ;
24 ;VARIABLES SET: RP - DATE OF SUPENSE RECORD
25 ; RO - ENTRY NUMBER IN SUSPENSE
26 S RP=0
27 F S RP=$O(^RMPR(668,"B",RP)) Q:RP'>0 D
28 .S RO=0
29 .F S RO=$O(^RMPR(668,"B",RP,RO)) Q:RO'>0 D CK1
30 G WRI
31 Q
32 ;
33CK1 ;screen records
34 Q:$P(^RMPR(668,RO,0),U,10)="X"
35 Q:$P(^RMPR(668,RO,0),U,10)="C"
36 ;
37 S DFN=$P(^RMPR(668,RO,0),U,2) Q:DFN=""
38 D DEM^VADPT
39 S ^TMP($J,$P(^RMPR(668,RO,0),U,1),$P(VADM(1),U,1),RO)=""
40 K VADM
41 Q
42 ;
43WRI I '$D(^TMP($J)) W !,"No Open/Pending Suspense Records",! G EXIT
44 ;date/time
45 S RP=0
46 F S RP=$O(^TMP($J,RP)) Q:RP="" D
47 .;patient name
48 .S RQ=""
49 .F S RQ=$O(^TMP($J,RP,RQ)) Q:RQ="" D
50 . .;record number
51 . .S RZ=""
52 . .F S RZ=$O(^TMP($J,RP,RQ,RZ)) Q:RZ=""!($D(RMPREND)) D WRI2
53 ;
54EXIT K ^TMP($J) D ^%ZISC,KILL^XUSCLEAN Q
55 ;
56WRI2 I RMPRPAGE=1,'$D(RMPRFL) W:$Y>1 @IOF D HEADER1 Q:$D(RMPREND)
57 I $Y>(IOSL-6),$E(IOST)["C",$D(RMPRFL) D HEADER Q:$D(RMPREND)
58 I $Y>(IOSL-6),$D(RMPRFL) W @IOF D HEADER1
59 ;
60 W !,$$DAT1^RMPRUTL1(RP)
61 W ?10,$$STATUS^RMPREOU(RZ,4)
62 S WRKDAY=$$CWRKDAY^RMPREOU(RZ) W " ",WRKDAY K WRKDAY
63 W ?24,$E($P(^DPT($P(^RMPR(668,RZ,0),U,2),0),U),1,20),?42,$E($P(^(0),U,9),6,9)
64 D TYPE
65 W ?61,$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") S RMPRFL=1
66 Q:$D(RMPREND)
67 ;
68 Q
69 ;
70HEADER W ! S DIR(0)="E" D ^DIR K DIR S:Y<1 RMPREND=1 Q:Y=""!(Y=0) W @IOF
71 ;
72HEADER1 Q:$D(RMPREND) S RMPRFL=1
73 W !,"Prosthetics Open/Pending Summary Suspense List "
74 N X,Y,% D NOW^%DTC S Y=% D DD^%DT S Y=$TR(Y,"@"," ") W $P(Y,":",1,2)
75 W ?70,"STA ",$$STA^RMPRUTIL,!,"DATE",?10,"STATUS",?24,"PATIENT"
76 W ?42,"SSN",?48,"TYPE",?61,"SUSPENDED BY",?73,"PAGE ",RMPRPAGE
77 W !,$$REPEAT^XLFSTR("-",79),!
78 S RMPRPAGE=RMPRPAGE+1 I $D(RMPRFLG) W !,"CON'T" K RMPRFLG
79 Q
80 ;
81TYPE S FO=$P(^RMPR(668,RZ,0),U,8) W ?48,$S(FO=1:"ROUTINE",FO=2:"EYEGLASS",FO=3:"CONTACT LENS",FO=4:"OXYGEN",FO=5:"MANUAL",1:"") Q
Note: See TracBrowser for help on using the repository browser.