- 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
- 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
