PXRMXTD ; SLC/PJH - Reminder Reports Template Display ;12/15/2009
;;2.0;CLINICAL REMINDERS;**4,6,12,17**;Feb 04, 2005;Build 102
;
; Called from PXRMXT/PXRMXTF
;
;
;Display Template information
START ;----------------------------
N PAGE,BMARG,DONE,SD,ED,DES,RDES,CDES,PSTART,PXRMOPT,IC,CNT
S PAGE=1,BMARG=0,DONE=0,SD="",ED="",PSTART=10,CNT=0
;
D LITS^PXRMXPR1
;
I PXRMREP="D" S PXRMOPT="Detailed Report"
I PXRMREP="S" S PXRMOPT="Summary Report"
W !!?(PSTART),"Report Title:",?32,$P(PXRMTMP,U,3)
W !?PSTART,"Report Type:",?32,$G(PXRMOPT)
W !?PSTART,"Patient Sample:",?32,PXRMFLD
I "LT"[PXRMSEL D
.W !,?PSTART,"Facility:" D FAC
I PXRMSEL'="L" W !,?PSTART,PXRMFLD,":" D ARRS
I PXRMSEL="L" D
.W !?PSTART,PXRMFLD,":",?32,DES
.I $E(PXRMLCSC,2)'="A" W ! D ARRS
I DONE Q
W !?PSTART,"Print Locations without Patients:",?32,$S($G(PXRMPML)=0:"NO",1:"YES")
W !?PSTART,"Print percentages with the output:",?32,$S($G(PXRMPER)=1:"YES",1:"NO")
S IC="" F S IC=$O(PXRMRCAT(IC)) Q:IC="" D Q:DONE
.W !,?PSTART W:IC=1 "Category:"
.W ?32,$P(PXRMRCAT(IC),U,3),?35,$P(PXRMRCAT(IC),U,2) D CHECK(1)
I DONE Q
S IC="" F S IC=$O(PXRMREM(IC)) Q:IC="" D Q:DONE
.W !,?PSTART W:IC=1 "Reminder:"
.W ?32,$P(PXRMREM(IC),U,3),?35,$P(PXRMREM(IC),U,2) D CHECK(1)
I DONE Q
I PXRMSEL="P" W !,?PSTART,"All/Primary:",?32,CDES
W !?(PSTART),"Template Name:",?32,$P(PXRMTMP,U,2)
W !?PSTART,"Date last run:",?32,$S(RUN]"":RUN,1:"n/a")
W !?PSTART,"Owner:",?32,$S(+$G(PXRMOWN)=0:"None",1:$$GET1^DIQ(200,PXRMOWN,.01))
I $D(PXRMSCAT),PXRMSCAT]"",PXRMFD="P" D OSCAT(PXRMSCAT,PSTART)
EXIT Q
;
;Display selected teams/providers
;--------------------------------
ARRS N IC
S IC=""
I PXRMSEL="P" F S IC=$O(PXRMPRV(IC)) Q:IC="" D Q:DONE
.W:IC>1 ! W ?32,$P(PXRMPRV(IC),U,2) D CHECK(1)
I PXRMSEL="T" F S IC=$O(PXRMPCM(IC)) Q:IC="" D Q:DONE
.W:IC>1 ! W ?32,$P(PXRMPCM(IC),U,2) D CHECK(1)
I PXRMSEL="O" F S IC=$O(PXRMOTM(IC)) Q:IC="" D Q:DONE
.W:IC>1 ! W ?32,$P(PXRMOTM(IC),U,2) D CHECK(1)
I PXRMSEL="I" F S IC=$O(PXRMPAT(IC)) Q:IC="" D Q:DONE
.W:IC>1 ! W ?32,$P(PXRMPAT(IC),U,2) D CHECK(1)
I PXRMSEL="R" F S IC=$O(PXRMLIST(IC)) Q:IC="" D Q:DONE
.W:IC>1 ! W ?32,$P(PXRMLIST(IC),U,2) D CHECK(1)
I PXRMSEL="L" D
.I $E(PXRMLCSC)="H" F S IC=$O(PXRMLCHL(IC)) Q:IC="" D
..W:IC>1 ! W ?32,$P(PXRMLCHL(IC),U) D CHECK(1)
.I $E(PXRMLCSC)="C" F S IC=$O(PXRMCS(IC)) Q:IC="" D
..W:IC>1 ! W ?32,$P(PXRMCS(IC),U)," ",$P(PXRMCS(IC),U,3)
..D CHECK(1)
.I $E(PXRMLCSC)="G" F S IC=$O(PXRMCGRP(IC)) Q:IC="" D
..W:IC>1 ! W ?32,$P(PXRMCGRP(IC),U)," ",$P(PXRMCGRP(IC),U,2)
..D CHECK(1)
Q
;
;Display selected Facilities
;---------------------------
FAC N IC
S IC=""
F S IC=$O(PXRMFAC(IC)) Q:IC="" D Q:DONE
.W:IC>1 ! W ?32,$P(PXRMFAC(IC),U,2) D CHECK(1)
Q
;
;
;Output the service categeories
;------------------------------
OSCAT(SCL,PSTART) ;
N IC,CSTART,EM,SC,SCTEXT
S CSTART=PSTART+3
W !,?PSTART,"Service categories:",?32,SCL
F IC=1:1:$L(SCL,",") D
.S SC=$P(SCL,",",IC)
.S SCTEXT=$$EXTERNAL^DILFD(9000010,.07,"",SC,.EM)
.W !,?CSTART,SC," - ",SCTEXT
.D CHECK(1)
Q
;
;Check for page throw
;--------------------
CHECK(LEAVE) ;
S CNT=CNT+1
I CNT>(IOSL-BMARG-LEAVE) D PAGE S CNT=0
Q
;
;form feed to new page
;---------------------
PAGE I ($E(IOST,1,2)="C-")&(IO=IO(0))&(PAGE>0) D
.S DIR(0)="E"
.W !
.D ^DIR K DIR
I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) S DONE=1 Q
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXTD 3509 printed Oct 16, 2024@17:51:17 Page 2
PXRMXTD ; SLC/PJH - Reminder Reports Template Display ;12/15/2009
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12,17**;Feb 04, 2005;Build 102
+2 ;
+3 ; Called from PXRMXT/PXRMXTF
+4 ;
+5 ;
+6 ;Display Template information
START ;----------------------------
+1 NEW PAGE,BMARG,DONE,SD,ED,DES,RDES,CDES,PSTART,PXRMOPT,IC,CNT
+2 SET PAGE=1
SET BMARG=0
SET DONE=0
SET SD=""
SET ED=""
SET PSTART=10
SET CNT=0
+3 ;
+4 DO LITS^PXRMXPR1
+5 ;
+6 IF PXRMREP="D"
SET PXRMOPT="Detailed Report"
+7 IF PXRMREP="S"
SET PXRMOPT="Summary Report"
+8 WRITE !!?(PSTART),"Report Title:",?32,$PIECE(PXRMTMP,U,3)
+9 WRITE !?PSTART,"Report Type:",?32,$GET(PXRMOPT)
+10 WRITE !?PSTART,"Patient Sample:",?32,PXRMFLD
+11 IF "LT"[PXRMSEL
Begin DoDot:1
+12 WRITE !,?PSTART,"Facility:"
DO FAC
End DoDot:1
+13 IF PXRMSEL'="L"
WRITE !,?PSTART,PXRMFLD,":"
DO ARRS
+14 IF PXRMSEL="L"
Begin DoDot:1
+15 WRITE !?PSTART,PXRMFLD,":",?32,DES
+16 IF $EXTRACT(PXRMLCSC,2)'="A"
WRITE !
DO ARRS
End DoDot:1
+17 IF DONE
QUIT
+18 WRITE !?PSTART,"Print Locations without Patients:",?32,$SELECT($GET(PXRMPML)=0:"NO",1:"YES")
+19 WRITE !?PSTART,"Print percentages with the output:",?32,$SELECT($GET(PXRMPER)=1:"YES",1:"NO")
+20 SET IC=""
FOR
SET IC=$ORDER(PXRMRCAT(IC))
if IC=""
QUIT
Begin DoDot:1
+21 WRITE !,?PSTART
if IC=1
WRITE "Category:"
+22 WRITE ?32,$PIECE(PXRMRCAT(IC),U,3),?35,$PIECE(PXRMRCAT(IC),U,2)
DO CHECK(1)
End DoDot:1
if DONE
QUIT
+23 IF DONE
QUIT
+24 SET IC=""
FOR
SET IC=$ORDER(PXRMREM(IC))
if IC=""
QUIT
Begin DoDot:1
+25 WRITE !,?PSTART
if IC=1
WRITE "Reminder:"
+26 WRITE ?32,$PIECE(PXRMREM(IC),U,3),?35,$PIECE(PXRMREM(IC),U,2)
DO CHECK(1)
End DoDot:1
if DONE
QUIT
+27 IF DONE
QUIT
+28 IF PXRMSEL="P"
WRITE !,?PSTART,"All/Primary:",?32,CDES
+29 WRITE !?(PSTART),"Template Name:",?32,$PIECE(PXRMTMP,U,2)
+30 WRITE !?PSTART,"Date last run:",?32,$SELECT(RUN]"":RUN,1:"n/a")
+31 WRITE !?PSTART,"Owner:",?32,$SELECT(+$GET(PXRMOWN)=0:"None",1:$$GET1^DIQ(200,PXRMOWN,.01))
+32 IF $DATA(PXRMSCAT)
IF PXRMSCAT]""
IF PXRMFD="P"
DO OSCAT(PXRMSCAT,PSTART)
EXIT QUIT
+1 ;
+2 ;Display selected teams/providers
+3 ;--------------------------------
ARRS NEW IC
+1 SET IC=""
+2 IF PXRMSEL="P"
FOR
SET IC=$ORDER(PXRMPRV(IC))
if IC=""
QUIT
Begin DoDot:1
+3 if IC>1
WRITE !
WRITE ?32,$PIECE(PXRMPRV(IC),U,2)
DO CHECK(1)
End DoDot:1
if DONE
QUIT
+4 IF PXRMSEL="T"
FOR
SET IC=$ORDER(PXRMPCM(IC))
if IC=""
QUIT
Begin DoDot:1
+5 if IC>1
WRITE !
WRITE ?32,$PIECE(PXRMPCM(IC),U,2)
DO CHECK(1)
End DoDot:1
if DONE
QUIT
+6 IF PXRMSEL="O"
FOR
SET IC=$ORDER(PXRMOTM(IC))
if IC=""
QUIT
Begin DoDot:1
+7 if IC>1
WRITE !
WRITE ?32,$PIECE(PXRMOTM(IC),U,2)
DO CHECK(1)
End DoDot:1
if DONE
QUIT
+8 IF PXRMSEL="I"
FOR
SET IC=$ORDER(PXRMPAT(IC))
if IC=""
QUIT
Begin DoDot:1
+9 if IC>1
WRITE !
WRITE ?32,$PIECE(PXRMPAT(IC),U,2)
DO CHECK(1)
End DoDot:1
if DONE
QUIT
+10 IF PXRMSEL="R"
FOR
SET IC=$ORDER(PXRMLIST(IC))
if IC=""
QUIT
Begin DoDot:1
+11 if IC>1
WRITE !
WRITE ?32,$PIECE(PXRMLIST(IC),U,2)
DO CHECK(1)
End DoDot:1
if DONE
QUIT
+12 IF PXRMSEL="L"
Begin DoDot:1
+13 IF $EXTRACT(PXRMLCSC)="H"
FOR
SET IC=$ORDER(PXRMLCHL(IC))
if IC=""
QUIT
Begin DoDot:2
+14 if IC>1
WRITE !
WRITE ?32,$PIECE(PXRMLCHL(IC),U)
DO CHECK(1)
End DoDot:2
+15 IF $EXTRACT(PXRMLCSC)="C"
FOR
SET IC=$ORDER(PXRMCS(IC))
if IC=""
QUIT
Begin DoDot:2
+16 if IC>1
WRITE !
WRITE ?32,$PIECE(PXRMCS(IC),U)," ",$PIECE(PXRMCS(IC),U,3)
+17 DO CHECK(1)
End DoDot:2
+18 IF $EXTRACT(PXRMLCSC)="G"
FOR
SET IC=$ORDER(PXRMCGRP(IC))
if IC=""
QUIT
Begin DoDot:2
+19 if IC>1
WRITE !
WRITE ?32,$PIECE(PXRMCGRP(IC),U)," ",$PIECE(PXRMCGRP(IC),U,2)
+20 DO CHECK(1)
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
+23 ;Display selected Facilities
+24 ;---------------------------
FAC NEW IC
+1 SET IC=""
+2 FOR
SET IC=$ORDER(PXRMFAC(IC))
if IC=""
QUIT
Begin DoDot:1
+3 if IC>1
WRITE !
WRITE ?32,$PIECE(PXRMFAC(IC),U,2)
DO CHECK(1)
End DoDot:1
if DONE
QUIT
+4 QUIT
+5 ;
+6 ;
+7 ;Output the service categeories
+8 ;------------------------------
OSCAT(SCL,PSTART) ;
+1 NEW IC,CSTART,EM,SC,SCTEXT
+2 SET CSTART=PSTART+3
+3 WRITE !,?PSTART,"Service categories:",?32,SCL
+4 FOR IC=1:1:$LENGTH(SCL,",")
Begin DoDot:1
+5 SET SC=$PIECE(SCL,",",IC)
+6 SET SCTEXT=$$EXTERNAL^DILFD(9000010,.07,"",SC,.EM)
+7 WRITE !,?CSTART,SC," - ",SCTEXT
+8 DO CHECK(1)
End DoDot:1
+9 QUIT
+10 ;
+11 ;Check for page throw
+12 ;--------------------
CHECK(LEAVE) ;
+1 SET CNT=CNT+1
+2 IF CNT>(IOSL-BMARG-LEAVE)
DO PAGE
SET CNT=0
+3 QUIT
+4 ;
+5 ;form feed to new page
+6 ;---------------------
PAGE IF ($EXTRACT(IOST,1,2)="C-")&(IO=IO(0))&(PAGE>0)
Begin DoDot:1
+1 SET DIR(0)="E"
+2 WRITE !
+3 DO ^DIR
KILL DIR
End DoDot:1
+4 IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIROUT))
SET DONE=1
QUIT
+5 WRITE !
+6 QUIT
