source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXTD.m@ 710

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

revised back to 6/30/08 version

File size: 3.1 KB
Line 
1PXRMXTD ; SLC/PJH - Reminder Reports Template Display ;11/03/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ; Called from PXRMXT/PXRMXTF
5 ;
6 ;
7 ;Display Template information
8START ;----------------------------
9 N PAGE,BMARG,DONE,SD,ED,DES,RDES,CDES,PSTART,PXRMOPT,IC,CNT
10 S PAGE=1,BMARG=0,DONE=0,SD="",ED="",PSTART=10,CNT=0
11 ;
12 D LITS^PXRMXPR1
13 ;
14 I PXRMREP="D" S PXRMOPT="Detailed Report"
15 I PXRMREP="S" S PXRMOPT="Summary Report"
16 W !!?(PSTART),"Report Title:",?32,$P(PXRMTMP,U,3)
17 W !?PSTART,"Report Type:",?32,$G(PXRMOPT)
18 W !?PSTART,"Patient Sample:",?32,PXRMFLD
19 I "LT"[PXRMSEL D
20 .W !,?PSTART,"Facility:" D FAC
21 I PXRMSEL'="L" W !,?PSTART,PXRMFLD,":" D ARRS
22 I PXRMSEL="L" D
23 .W !?PSTART,PXRMFLD,":",?32,DES
24 .I $E(PXRMLCSC,2)'="A" W ! D ARRS
25 I DONE Q
26 S IC="" F S IC=$O(PXRMRCAT(IC)) Q:IC="" D Q:DONE
27 .W !,?PSTART W:IC=1 "Category:"
28 .W ?32,$P(PXRMRCAT(IC),U,3),?35,$P(PXRMRCAT(IC),U,2) D CHECK(1)
29 I DONE Q
30 S IC="" F S IC=$O(PXRMREM(IC)) Q:IC="" D Q:DONE
31 .W !,?PSTART W:IC=1 "Reminder:"
32 .W ?32,$P(PXRMREM(IC),U,3),?35,$P(PXRMREM(IC),U,2) D CHECK(1)
33 I DONE Q
34 I PXRMSEL="P" W !,?PSTART,"All/Primary:",?32,CDES
35 W !?(PSTART),"Template Name:",?32,$P(PXRMTMP,U,2)
36 W !?PSTART,"Date last run:",?32,$S(RUN]"":RUN,1:"n/a")
37 I $D(PXRMSCAT),PXRMSCAT]"",PXRMFD="P" D OSCAT(PXRMSCAT,PSTART)
38EXIT Q
39 ;
40 ;Display selected teams/providers
41 ;--------------------------------
42ARRS N IC
43 S IC=""
44 I PXRMSEL="P" F S IC=$O(PXRMPRV(IC)) Q:IC="" D Q:DONE
45 .W:IC>1 ! W ?32,$P(PXRMPRV(IC),U,2) D CHECK(1)
46 I PXRMSEL="T" F S IC=$O(PXRMPCM(IC)) Q:IC="" D Q:DONE
47 .W:IC>1 ! W ?32,$P(PXRMPCM(IC),U,2) D CHECK(1)
48 I PXRMSEL="O" F S IC=$O(PXRMOTM(IC)) Q:IC="" D Q:DONE
49 .W:IC>1 ! W ?32,$P(PXRMOTM(IC),U,2) D CHECK(1)
50 I PXRMSEL="I" F S IC=$O(PXRMPAT(IC)) Q:IC="" D Q:DONE
51 .W:IC>1 ! W ?32,$P(PXRMPAT(IC),U,2) D CHECK(1)
52 I PXRMSEL="R" F S IC=$O(PXRMLIST(IC)) Q:IC="" D Q:DONE
53 .W:IC>1 ! W ?32,$P(PXRMLIST(IC),U,2) D CHECK(1)
54 I PXRMSEL="L" D
55 .I $E(PXRMLCSC)="H" F S IC=$O(PXRMLCHL(IC)) Q:IC="" D
56 ..W:IC>1 ! W ?32,$P(PXRMLCHL(IC),U) D CHECK(1)
57 .I $E(PXRMLCSC)="C" F S IC=$O(PXRMCS(IC)) Q:IC="" D
58 ..W:IC>1 ! W ?32,$P(PXRMCS(IC),U)," ",$P(PXRMCS(IC),U,3)
59 ..D CHECK(1)
60 .I $E(PXRMLCSC)="G" F S IC=$O(PXRMCGRP(IC)) Q:IC="" D
61 ..W:IC>1 ! W ?32,$P(PXRMCGRP(IC),U)," ",$P(PXRMCGRP(IC),U,2)
62 ..D CHECK(1)
63 Q
64 ;
65 ;Display selected Facilities
66 ;---------------------------
67FAC N IC
68 S IC=""
69 F S IC=$O(PXRMFAC(IC)) Q:IC="" D Q:DONE
70 .W:IC>1 ! W ?32,$P(PXRMFAC(IC),U,2) D CHECK(1)
71 Q
72 ;
73 ;
74 ;Output the service categeories
75 ;------------------------------
76OSCAT(SCL,PSTART) ;
77 N IC,CSTART,EM,SC,SCTEXT
78 S CSTART=PSTART+3
79 W !,?PSTART,"Service categories:",?32,SCL
80 F IC=1:1:$L(SCL,",") D
81 .S SC=$P(SCL,",",IC)
82 .S SCTEXT=$$EXTERNAL^DILFD(9000010,.07,"",SC,.EM)
83 .W !,?CSTART,SC," - ",SCTEXT
84 .D CHECK(1)
85 Q
86 ;
87 ;Check for page throw
88 ;--------------------
89CHECK(LEAVE) ;
90 S CNT=CNT+1
91 I CNT>(IOSL-BMARG-LEAVE) D PAGE S CNT=0
92 Q
93 ;
94 ;form feed to new page
95 ;---------------------
96PAGE I ($E(IOST)="C")&(IO=IO(0))&(PAGE>0) D
97 .S DIR(0)="E"
98 .W !
99 .D ^DIR K DIR
100 I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) S DONE=1 Q
101 W !
102 Q
Note: See TracBrowser for help on using the repository browser.