source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRSP.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1RMPRSP ;HINES-IO/HNC-PRINT SUSPENSE RECORDS ;7/28/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 ;main entry point
10 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT
11 I '$D(IO("Q")) U IO G PRINT
12 K IO("Q") S ZTDESC="PRINT OPEN PENDING SUSPENSE RECORDS",ZTRTN="PRINT^RMPRSP",ZTIO=ION
13 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
14 ;
15PRINT ;print
16 W:$E(IOST)["C" @IOF
17 I '$D(IO("Q")) U IO
18 ;
19MAIN ;main sort logic
20 ;VARIABLES SET: ST - STATUS
21 ; RO - ENTRY NUMBER IN SUSPENSE
22 ;
23 K RMPREND,^TMP($J)
24 S RMPRPAGE=1 D HEADER1
25 ;
26 S ST="C"
27 F S ST=$O(^RMPR(668,"E",ST)) Q:ST="" Q:ST="X" D
28 .S RO=0
29 .F S RO=$O(^RMPR(668,"E",ST,RO)) Q:RO'>0 D
30 . .Q:$P(^RMPR(668,RO,0),U,10)="X"
31 . .Q:$P(^RMPR(668,RO,0),U,10)="C"
32 . .S DATE=$P($P(^RMPR(668,RO,0),U,1),".",1)
33 . .S DFN=$P(^RMPR(668,RO,0),U,2) Q:DFN=""
34 . .D DEM^VADPT
35 . .S ^TMP($J,DATE,VADM(1),RO)=""
36 . .K DFN
37 ;end sort
38 ;
39 I '$D(^TMP($J)) W !,"No Open/Pending Suspense Records",! G EXIT
40 ;
41 S DATE=0
42 F S DATE=$O(^TMP($J,DATE)) Q:DATE'>0 Q:$D(RMPREND) D
43 .S NAME=""
44 .F S NAME=$O(^TMP($J,DATE,NAME)) Q:NAME="" Q:$D(RMPREND) D
45 . .S RO=0
46 . .F S RO=$O(^TMP($J,DATE,NAME,RO)) Q:RO="" Q:$D(RMPREND) D
47 . . .K VADM S DFN=$P(^RMPR(668,RO,0),U,2) D DEM^VADPT
48 . . .I $Y>(IOSL-6),$E(IOST)["C",$G(RMPRFL)'="" D HEADER Q:$D(RMPREND)
49 . . .D DISPLAY
50 . . .W !,$$REPEAT^XLFSTR("-",79)
51 D EXIT
52 Q
53 ;
54DISPLAY ;display record
55 W !,$$DAT1^RMPRUTL1(DATE)
56 W ?10,$E(VADM(1),0,18)
57 W ?28,$P($P(VADM(2),U,2),"-",3)
58 W ?34,$$STATUS^RMPREOU(RO,4)," "
59 S WRKDAY=$$CWRKDAY^RMPREOU(RO) W WRKDAY
60 W ?44,$$TYPE^RMPREOU(RO,8)
61 I $P(^RMPR(668,RO,0),U,7)'="" W ?59,$P(^DIC(4,$P(^RMPR(668,RO,0),U,7),0),U,1)
62 W !,$$DES^RMPREOU(RO,79)
63 S INIA=$P(^RMPR(668,RO,0),U,9),INIDAY=$$WRKDAY^RMPREOU(RO)
64 I INIA'="" W !,"**Initial Action Date: ",$$DAT1^RMPRUTL1(INIA)," (",INIDAY," Working Days)"
65 ;then display the number of working days to init action.
66 I S INIAN=0 D
67 .F S INIAN=$O(^RMPR(668,RO,3,INIAN)) Q:INIAN="" D
68 . .W !,^RMPR(668,RO,3,INIAN,0)
69 S ODAT=0
70 F S ODAT=$O(^RMPR(668,RO,1,ODAT)) Q:ODAT'>0 D
71 .S ODAT1=$P(^RMPR(668,RO,1,ODAT,0),U,1)
72 .W !,"**Other Action Date: ",$$DAT1^RMPRUTL1(ODAT1)
73 .S ODATN=0
74 .F S ODATN=$O(^RMPR(668,RO,1,ODAT,1,ODATN)) Q:ODATN="" D
75 . .W !,^RMPR(668,RO,1,ODAT,1,ODATN,0)
76 K INIAN,ODATN,ODAT,ODAT1
77 Q
78 ;
79HEADER W ! S DIR(0)="E" D ^DIR K DIR S:Y<1 RMPREND=1 Q:Y=""!(Y=0) W @IOF
80 ;
81HEADER1 ;main header
82 Q:$D(RMPREND) S RMPRFL=1
83 W !,"Prosthetics Open/Pending Suspense File List "
84 N X,Y,% D NOW^%DTC S Y=% D DD^%DT S Y=$TR(Y,"@"," ") W $P(Y,":",1,2)
85 ;W ?70,"STA ",$$STA^RMPRUTIL
86 W !,"DATE",?10,"PATIENT",?28,"SSN",?34,"STATUS",?44,"TYPE",?59,"STATION",?73,"PAGE ",RMPRPAGE
87 W !,$$REPEAT^XLFSTR("-",79) S RMPRPAGE=RMPRPAGE+1 I $D(RMPRFLG) W !,"CON'T" K RMPRFLG
88 Q
89 ;
90EXIT K ^TMP($J) D ^%ZISC,KILL^XUSCLEAN
91 Q
92 ;end
Note: See TracBrowser for help on using the repository browser.