[623] | 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
|
---|