1 | PXRMXTD ; 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
|
---|
8 | START ;----------------------------
|
---|
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)
|
---|
38 | EXIT Q
|
---|
39 | ;
|
---|
40 | ;Display selected teams/providers
|
---|
41 | ;--------------------------------
|
---|
42 | ARRS 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 | ;---------------------------
|
---|
67 | FAC 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 | ;------------------------------
|
---|
76 | OSCAT(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 | ;--------------------
|
---|
89 | CHECK(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 | ;---------------------
|
---|
96 | PAGE 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
|
---|