PXRMXGPR ; SLC/PJH - Reminder Due print calls ;23-Mar-2015 10:41;DU
;;2.0;CLINICAL REMINDERS;**4,6,1001,12,1005**;Feb 04, 2005;Build 23
;;IHS/MSC/MGH Patch 1001 added data for IHS primary provider
;Called from PXRMXPR
;
DOPER(TOTAL,APPL,DUE) ;
N PERAPPL,PERDONE,PERDUE
I APPL=0 Q "0^0^0"
S PERAPPL=(APPL/TOTAL)*100 I $P(PERAPPL,".",2)>4 S PERAPPL=PERAPPL+1
S PERDUE=(DUE/APPL)*100 I $P(PERDUE,".",2)>4 S PERDUE=PERDUE+1
S PERDUE=$P(PERDUE,"."),PERAPPL=$P(PERAPPL,".")
S PERDONE=$S(PERDUE=0:100,1:(100-PERDUE))
Q PERAPPL_U_PERDUE_U_PERDONE
;
;Print Selection criteria
HEAD(PSTART) ;
I SUB="TOTAL" N NAM S NAM="TOTAL REPORT"
I PXRMTABS="Y" D Q
.N FFAC,FNAM
.S FNAM=NAM
.I "CES"[PXRMTABC S FNAM=$TR(FNAM,SEP,"_")
.I PXRMFCMB="N","LT"[PXRMSEL D Q
..S FFAC=$TR(FACPNAME,SEP,"_")
..W !,"0"_SEP_FFAC_"_"_FNAM_SEP_SEP
.I PXRMFCMB="N","LT"'[PXRMSEL W !,"0"_SEP_FNAM_SEP_SEP Q
.I PXRMFCMB="Y" W !,"0"_SEP_"COMBINED_REPORT_"_FNAM_SEP_SEP Q
I "LT"[PXRMSEL D
.I PXRMFCMB="N" W !,?PSTART,"Facility: ",FACPNAME Q
.W !,?PSTART,"Combined Report: "
.N FACN,LENGTH,TEXT
.S FACN=0,LENGTH=17+PSTART
.F S FACN=$O(PXRMFACN(FACN)) Q:'FACN D
..S TEXT=$P(PXRMFACN(FACN),U)_" ("_FACN_")"
..I $O(PXRMFACN(FACN)) S TEXT=TEXT_", "
..I (LENGTH+$L(TEXT))>80 S LENGTH=17+PSTART W !,?(17+PSTART)
..W TEXT S LENGTH=LENGTH+$L(TEXT)
I "PTO"[PXRMSEL D
.I SUB="TOTAL" W !,?PSTART,NAM Q
.W !,?PSTART,"Reminders "_PXRMTX_" for ",NAM
I PXRMSEL="L" D
.N CNT,NOUT,TEXTIN,TEXTOUT
.S TEXTIN(1)="Reminders "_PXRMTX_" "_SD_" - "_NAM
.I "PF"[PXRMFD S TEXTIN(1)=TEXTIN(1)_" for "_BD_" to "_ED
.I PXRMFD="A" S TEXTIN(1)=TEXTIN(1)_" admissions from "_BD_" to "_ED
.I PXRMFD="C" S TEXTIN(1)=TEXTIN(1)_" for current inpatients"
.D FORMAT^PXRMTEXT(PSTART,75,1,.TEXTIN,.NOUT,.TEXTOUT)
.F CNT=1:1:NOUT W !,TEXTOUT(CNT)
I PXRMSEL="R" W !,"Patient List: "_SUB
I PXRMSEL'="L" W " for ",SD
W:PXRMSEL="I" !
;
Q
;
;Output the provider report criteria
CRIT(PSTART,PLSTCRIT) ;
N CNT,RCCNT,RCDES,RICNT,RIDES,UNDL
S CNT=0
S UNDL=$TR($J("",79)," ","_") D LITS^PXRMXPR1
S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART-8)_"Report Criteria:",CNT=CNT+1
I PXRMTMP'="" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Report Title:",22)_$P(PXRMTMP,U,3),CNT=CNT+1
S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Patient Sample:",22)_PXRMFLD,CNT=CNT+1
I PXRMSEL'="L" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR(PXRMFLD_":",22) D DISP(.CNT,.PLSTCRIT)
I PXRMSEL="L" D
.S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR(PXRMFLD_":",22)_DES,CNT=CNT+1
.I $E(PXRMLCSC,2)'="A" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",10) D DISP(.CNT,.PLSTCRIT)
I $D(PXRMRCAT) D
.S RCCNT=0
.F S RCCNT=$O(PXRMRCAT(RCCNT)) Q:'RCCNT D
..S RCDES=$P(PXRMRCAT(RCCNT),U,2)
..I RCCNT=1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Reminder Category:",22)_RCDES_U_6,CNT=CNT+1
..I RCCNT>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",22)_RCDES
.S RICNT=0
.F S RICNT=$O(PXRMREM(RICNT)) Q:'RICNT D
..S RIDES=$P(PXRMREM(RICNT),U,2)
..I RICNT=1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Individual Reminder:",22)_RIDES_U_6,CNT=CNT+1
..I RICNT>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",22)_RIDES,CNT=CNT+1
S PLSTCRIT(CNT)=U_6,CNT=CNT+1
I PXRMREP="D" D
.S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Reminder:",22)_RDES,CNT=CNT+1
.;Display future appointments for Reminder Due report only
.I PXRMRT="PXRMX" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_"Appointments:" D
..I PXRMFUT="Y" S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$$LJ^XLFSTR(" ",32-$L(PLSTCRIT(CNT)))_"All Future Appointments",CNT=CNT+1
..I PXRMFUT="N" S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$$LJ^XLFSTR(" ",32-$L(PLSTCRIT(CNT)))_"Next Appointment only",CNT=CNT+1
I PXRMSEL="P" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("All/Primary:",22)_CDES,CNT=CNT+1
I PXRMSEL="L" D S CNT=CNT+1
.S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Date Range:",22)
.I "PAF"[PXRMFD S PLSTCRIT(CNT)=PLSTCRIT(CNT)_BD_" to "_ED Q
.I PXRMFD="C" S PLSTCRIT(CNT)=PLSTCRIT(CNT)_"not applicable" Q
S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Effective Due Date:",22)_SD,CNT=CNT+1
S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Date run:",22)_RD,CNT=CNT+1
I PXRMTMP'="" D
.S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Template Name:",22)_$P(PXRMTMP,U,2),CNT=CNT+1
.I PXRMUSER S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Requested by:",22)_$$GET1^DIQ(200,DUZ,.01)_U_3,CNT=CNT+1
I (PXRMFCMB="Y")!(PXRMLCMB="Y")!(PXRMTCMB="Y") D
.N LIT,TEXT
.S LIT=$S(PXRMSEL="P":"Providers","OT"[PXRMSEL:"Teams",1:"Locations")
.S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Combined report:",22)
.I PXRMFCMB="Y",PXRMLCMB="Y" S TEXT="Combined Facility and Combined "_LIT
.I PXRMFCMB="Y",PXRMLCMB="N" S TEXT="Combined Facility by Individual "_LIT
.I PXRMLCMB="Y",PXRMFCMB="N" S TEXT="Combined "_LIT
.I PXRMTCMB="Y" S TEXT="Combined "_LIT
.S PLSTCRIT(CNT)=PLSTCRIT(CNT)_TEXT,CNT=CNT+1
.S PLSTCRIT(CNT)=U_3,CNT=CNT+1
I PXRMREP="S","IRT"[PXRMTOT,"IR"'[PXRMSEL D
.N LIT1,LIT2,LIT3,TEXT
.D LIT^PXRMXD
.S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Summary report:",22)
.I PXRMTOT="I" S TEXT=LIT1
.I PXRMTOT="R" S TEXT=LIT2
.I PXRMTOT="T" S TEXT=LIT3
.S PLSTCRIT(CNT)=PLSTCRIT(CNT)_TEXT,CNT=CNT+1
.S PLSTCRIT(CNT)=U_3,CNT=CNT+1
I $D(PXRMSCAT),PXRMSCAT]"",PXRMFD="P" D OSCAT(PXRMSCAT,PSTART,.CNT,.PLSTCRIT)
N CHECK,CNT,NODE,STR
S CNT=0 F S CNT=$O(PLSTCRIT(CNT)) Q:CNT'>0 D
.S NODE=$G(PLSTCRIT(CNT)),CHECK=$P(NODE,U,2),STR=$P(NODE,U)
.I CHECK>0 D CHECK(CHECK) I STR="" Q
.W !,STR
W !,UNDL,!
Q
;
;Display selected teams/providers
DISP(CNT,PLSTCRIT) ;
N IC
S IC=""
;IHS/MSC/MGH PATCH 1001 Added "D" for IHS provider
I PXRMSEL="P"!(PXRMSEL="D") F S IC=$O(PXRMPRV(IC)) Q:IC="" D
.I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMPRV(IC),U,2),CNT=CNT+1
.I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMPRV(IC),U,2),CNT=CNT+1
.S PLSTCRIT(CNT)=U_3,CNT=CNT+1
I PXRMSEL="T" F S IC=$O(PXRMPCM(IC)) Q:IC="" D
.I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMPCM(IC),U,2),CNT=CNT+1
.I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMPCM(IC),U,2),CNT=CNT+1
.S PLSTCRIT(CNT)=U_3,CNT=CNT+1
I PXRMSEL="O" F S IC=$O(PXRMOTM(IC)) Q:IC="" D
.I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMOTM(IC),U,3),CNT=CNT+1
.I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMOTM(IC),U,2),CNT=CNT+1
.S PLSTCRIT(CNT)=U_3,CNT=CNT+1
I PXRMSEL="I" F S IC=$O(PXRMPAT(IC)) Q:IC="" D
.I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMPAT(IC),U,2),CNT=CNT+1
.I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMPAT(IC),U,2),CNT=CNT+1
.S PLSTCRIT(CNT)=U_3,CNT=CNT+1
I PXRMSEL="R" F S IC=$O(PXRMLIST(IC)) Q:IC="" D
.I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMLIST(IC),U,2),CNT=CNT+1
.I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMLIST(IC),U,2),CNT=CNT+1
.S PLSTCRIT(CNT)=U_3,CNT=CNT+1
I PXRMSEL="L" D
.I $E(PXRMLCSC)="H" F S IC=$O(^XTMP(PXRMXTMP,"HLOC",IC)) Q:IC="" D
..S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(^XTMP(PXRMXTMP,"HLOC",IC),U,2),CNT=CNT+1
..S PLSTCRIT(CNT)=U_3,CNT=CNT+1
.I $E(PXRMLCSC)="C" F S IC=$O(PXRMCS(IC)) Q:IC="" D
..S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMCS(IC),U,1)_" "_$P(PXRMCS(IC),U,3),CNT=CNT+1
..S PLSTCRIT(CNT)=U_3,CNT=CNT+1
..I PXRMCCS="I" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_"Report by Individual Clinic(s)",CNT=CNT+1
..I PXRMCCS="B" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_"Report by Clinic Stops and Individual Clinic(s)",CNT=CNT+1
.I $E(PXRMLCSC)="G" F S IC=$O(PXRMCGRP(IC)) Q:IC="" D
..S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMCGRP(IC),U,2),CNT=CNT+1
..S PLSTCRIT(CNT)=U_3,CNT=CNT+1
Q
;
;Output the service categories
OSCAT(SCL,PSTART,CNT,PLSTCRIT) ;
N IC,CSTART,EM,SC,SCTEXT
S CSTART=PSTART+3
S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Service categories:",22)_SCL,CNT=CNT+1
F IC=1:1:$L(SCL,",") D
.S SC=$P(SCL,",",IC)
.S SCTEXT=$$EXTERNAL^DILFD(9000010,.07,"",SC,.EM)
.S PLSTCRIT(CNT)=U_3,CNT=CNT+1
.S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",CSTART)_SC_" - "_SCTEXT,CNT=CNT+1
Q
;
;If necessary, write the header
COL(NEWPAGE) ;
I NEWPAGE D Q:DONE
.I PXRMTABS="N" D PAGE
.I PXRMTABS="Y" W !!
D CHECK(0) Q:DONE
D HEAD(0)
S HEAD=0
I PXRMTABS="Y" Q
I PXRMREP="D" D
.N PNAM
.S PNAM=$P(PXRMREM(1),U,4) I PNAM="" S PNAM=$P(PXRMREM(1),U,2)
.W !!,PNAM,": ",COUNT
.W:COUNT>1 " patients have the reminder "_PXRMTX
.W:COUNT=1 " patient has the reminder "_PXRMTX
N IC F IC=0:1:2 W !,?PXRMT(IC),PXRMH(IC)
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:$D(IOF)&(PAGE>0) @IOF
S PAGE=PAGE+1,FIRST=0
I $E(IOST,1,2)="C-",IO=IO(0) W @IOF
E W !
N TEMP,TEXTLEN
S TEMP=$$NOW^XLFDT,TEMP=$$FMTE^XLFDT(TEMP,"P")
S TEMP=TEMP_" Page "_PAGE
S TEXTLEN=$L(TEMP)
W ?(IOM-TEXTLEN),TEMP
S TEXTLEN=$L(PXRMOPT)
I TEXTLEN>0 D
.W !!
.W ?((IOM-TEXTLEN)/2),PXRMOPT
Q
;
;count of patients in sample
TOTAL ;
N LIT,PERAPPL,PERDONE,PERDUE,PERCENT
;determine percentages for detail reports
I PXRMREP="D",PXRMPER="1" D
.S PERCENT=$$DOPER(TOTAL,APPL,COUNT)
.S PERAPPL=$P(PERCENT,U),PERDUE=$P(PERCENT,U,2),PERDONE=$P(PERCENT,U,3)
;delimited reports
I PXRMTABS="Y" D Q
.I PXRMREP="D" D Q
..I PXRMPER="1" W !,"0"_SEP_"PATIENTS"_SEP_TOTAL_SEP_"APPLICABLE"_SEP_APPL_SEP_"%APPL"_SEP_PERAPPL_SEP_"%DUE"_SEP_PERDUE_SEP_"%DONE"_SEP_PERDONE Q
..W !,"0"_SEP_"PATIENTS"_SEP_TOTAL_SEP_"APPLICABLE"_SEP_APPL
.I PXRMREP="S" W !,"0"_SEP_"PATIENTS"_SEP_TOTAL_SEP_SEP_$TR(SUB,SEP,"_") Q
;
I (PXRMRT="PXRMX")!(PXRMREP="S") W !
;S LIT=" patient."
;I TOTAL>1 S LIT=" patients."
S LIT=$S(TOTAL=0:" patients.",TOTAL=1:" patient.",1:" patients.")
W !,"Report run on "_TOTAL_LIT
I PXRMREP="D" D
.S LIT=$S(APPL=0:" patients.",APPL=1:" patient.",1:" patients.")
.W !,"Applicable to "_APPL_LIT
.I PXRMPER="1" D
..W !,"%Applicable "_PERAPPL
..W !,"%Due "_PERDUE
..W !,"%Done "_PERDONE
Q
;
;Null report prints if no patients found
NULL I PXRMSEL="L" D
.I PXRMFD="P" W !!,"No patient visits found"
.I PXRMFD="A" W !!,"No patient admissions found"
.I PXRMFD="C" W !!,"No current inpatient found"
.I PXRMFD="F" W !!,"No patient appointments found"
I PXRMSEL="P" W !!,"No patients found for provider(s) selected"
;IHS/MSC/MGH Patch 1001 added for IHS providers
I PXRMSEL="D" W !!,"No patients found for provider(s) selected"
I "OT"[PXRMSEL W !!,"No patients found for team(s) selected"
Q
;
;Null report if no patients due/satisfied - detailed report only
NONE D PAGE
D HEAD(0)
W !!,"No patients with reminders "_PXRMTX
Q
;
SPACER(TEXT,LENGTH) ;
Q
;
;Check for page throw
CHECK(CNT) ;
I PXRMTABS="N",$Y>(IOSL-BMARG-CNT) D PAGE
Q
PXRMXGPR ; SLC/PJH - Reminder Due print calls ;23-Mar-2015 10:41;DU
+1 ;;2.0;CLINICAL REMINDERS;**4,6,1001,12,1005**;Feb 04, 2005;Build 23
+2 ;;IHS/MSC/MGH Patch 1001 added data for IHS primary provider
+3 ;Called from PXRMXPR
+4 ;
DOPER(TOTAL,APPL,DUE) ;
+1 NEW PERAPPL,PERDONE,PERDUE
+2 IF APPL=0
QUIT "0^0^0"
+3 SET PERAPPL=(APPL/TOTAL)*100
IF $PIECE(PERAPPL,".",2)>4
SET PERAPPL=PERAPPL+1
+4 SET PERDUE=(DUE/APPL)*100
IF $PIECE(PERDUE,".",2)>4
SET PERDUE=PERDUE+1
+5 SET PERDUE=$PIECE(PERDUE,".")
SET PERAPPL=$PIECE(PERAPPL,".")
+6 SET PERDONE=$SELECT(PERDUE=0:100,1:(100-PERDUE))
+7 QUIT PERAPPL_U_PERDUE_U_PERDONE
+8 ;
+9 ;Print Selection criteria
HEAD(PSTART) ;
+1 IF SUB="TOTAL"
NEW NAM
SET NAM="TOTAL REPORT"
+2 IF PXRMTABS="Y"
Begin DoDot:1
+3 NEW FFAC,FNAM
+4 SET FNAM=NAM
+5 IF "CES"[PXRMTABC
SET FNAM=$TRANSLATE(FNAM,SEP,"_")
+6 IF PXRMFCMB="N"
IF "LT"[PXRMSEL
Begin DoDot:2
+7 SET FFAC=$TRANSLATE(FACPNAME,SEP,"_")
+8 WRITE !,"0"_SEP_FFAC_"_"_FNAM_SEP_SEP
End DoDot:2
QUIT
+9 IF PXRMFCMB="N"
IF "LT"'[PXRMSEL
WRITE !,"0"_SEP_FNAM_SEP_SEP
QUIT
+10 IF PXRMFCMB="Y"
WRITE !,"0"_SEP_"COMBINED_REPORT_"_FNAM_SEP_SEP
QUIT
End DoDot:1
QUIT
+11 IF "LT"[PXRMSEL
Begin DoDot:1
+12 IF PXRMFCMB="N"
WRITE !,?PSTART,"Facility: ",FACPNAME
QUIT
+13 WRITE !,?PSTART,"Combined Report: "
+14 NEW FACN,LENGTH,TEXT
+15 SET FACN=0
SET LENGTH=17+PSTART
+16 FOR
SET FACN=$ORDER(PXRMFACN(FACN))
IF 'FACN
QUIT
Begin DoDot:2
+17 SET TEXT=$PIECE(PXRMFACN(FACN),U)_" ("_FACN_")"
+18 IF $ORDER(PXRMFACN(FACN))
SET TEXT=TEXT_", "
+19 IF (LENGTH+$LENGTH(TEXT))>80
SET LENGTH=17+PSTART
WRITE !,?(17+PSTART)
+20 WRITE TEXT
SET LENGTH=LENGTH+$LENGTH(TEXT)
End DoDot:2
End DoDot:1
+21 IF "PTO"[PXRMSEL
Begin DoDot:1
+22 IF SUB="TOTAL"
WRITE !,?PSTART,NAM
QUIT
+23 WRITE !,?PSTART,"Reminders "_PXRMTX_" for ",NAM
End DoDot:1
+24 IF PXRMSEL="L"
Begin DoDot:1
+25 NEW CNT,NOUT,TEXTIN,TEXTOUT
+26 SET TEXTIN(1)="Reminders "_PXRMTX_" "_SD_" - "_NAM
+27 IF "PF"[PXRMFD
SET TEXTIN(1)=TEXTIN(1)_" for "_BD_" to "_ED
+28 IF PXRMFD="A"
SET TEXTIN(1)=TEXTIN(1)_" admissions from "_BD_" to "_ED
+29 IF PXRMFD="C"
SET TEXTIN(1)=TEXTIN(1)_" for current inpatients"
+30 DO FORMAT^PXRMTEXT(PSTART,75,1,.TEXTIN,.NOUT,.TEXTOUT)
+31 FOR CNT=1:1:NOUT
WRITE !,TEXTOUT(CNT)
End DoDot:1
+32 IF PXRMSEL="R"
WRITE !,"Patient List: "_SUB
+33 IF PXRMSEL'="L"
WRITE " for ",SD
+34 IF PXRMSEL="I"
WRITE !
+35 ;
+36 QUIT
+37 ;
+38 ;Output the provider report criteria
CRIT(PSTART,PLSTCRIT) ;
+1 NEW CNT,RCCNT,RCDES,RICNT,RIDES,UNDL
+2 SET CNT=0
+3 SET UNDL=$TRANSLATE($JUSTIFY("",79)," ","_")
DO LITS^PXRMXPR1
+4 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART-8)_"Report Criteria:"
SET CNT=CNT+1
+5 IF PXRMTMP'=""
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Report Title:",22)_$PIECE(PXRMTMP,U,3)
SET CNT=CNT+1
+6 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Patient Sample:",22)_PXRMFLD
SET CNT=CNT+1
+7 IF PXRMSEL'="L"
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR(PXRMFLD_":",22)
DO DISP(.CNT,.PLSTCRIT)
+8 IF PXRMSEL="L"
Begin DoDot:1
+9 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR(PXRMFLD_":",22)_DES
SET CNT=CNT+1
+10 IF $EXTRACT(PXRMLCSC,2)'="A"
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",10)
DO DISP(.CNT,.PLSTCRIT)
End DoDot:1
+11 IF $DATA(PXRMRCAT)
Begin DoDot:1
+12 SET RCCNT=0
+13 FOR
SET RCCNT=$ORDER(PXRMRCAT(RCCNT))
IF 'RCCNT
QUIT
Begin DoDot:2
+14 SET RCDES=$PIECE(PXRMRCAT(RCCNT),U,2)
+15 IF RCCNT=1
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Reminder Category:",22)_RCDES_U_6
SET CNT=CNT+1
+16 IF RCCNT>1
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",22)_RCDES
End DoDot:2
+17 SET RICNT=0
+18 FOR
SET RICNT=$ORDER(PXRMREM(RICNT))
IF 'RICNT
QUIT
Begin DoDot:2
+19 SET RIDES=$PIECE(PXRMREM(RICNT),U,2)
+20 IF RICNT=1
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Individual Reminder:",22)_RIDES_U_6
SET CNT=CNT+1
+21 IF RICNT>1
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",22)_RIDES
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+22 SET PLSTCRIT(CNT)=U_6
SET CNT=CNT+1
+23 IF PXRMREP="D"
Begin DoDot:1
+24 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Reminder:",22)_RDES
SET CNT=CNT+1
+25 ;Display future appointments for Reminder Due report only
+26 IF PXRMRT="PXRMX"
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_"Appointments:"
Begin DoDot:2
+27 IF PXRMFUT="Y"
SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$$LJ^XLFSTR(" ",32-$LENGTH(PLSTCRIT(CNT)))_"All Future Appointments"
SET CNT=CNT+1
+28 IF PXRMFUT="N"
SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$$LJ^XLFSTR(" ",32-$LENGTH(PLSTCRIT(CNT)))_"Next Appointment only"
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+29 IF PXRMSEL="P"
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("All/Primary:",22)_CDES
SET CNT=CNT+1
+30 IF PXRMSEL="L"
Begin DoDot:1
+31 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Date Range:",22)
+32 IF "PAF"[PXRMFD
SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_BD_" to "_ED
QUIT
+33 IF PXRMFD="C"
SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_"not applicable"
QUIT
End DoDot:1
SET CNT=CNT+1
+34 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Effective Due Date:",22)_SD
SET CNT=CNT+1
+35 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Date run:",22)_RD
SET CNT=CNT+1
+36 IF PXRMTMP'=""
Begin DoDot:1
+37 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Template Name:",22)_$PIECE(PXRMTMP,U,2)
SET CNT=CNT+1
+38 IF PXRMUSER
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Requested by:",22)_$$GET1^DIQ(200,DUZ,.01)_U_3
SET CNT=CNT+1
End DoDot:1
+39 IF (PXRMFCMB="Y")!(PXRMLCMB="Y")!(PXRMTCMB="Y")
Begin DoDot:1
+40 NEW LIT,TEXT
+41 SET LIT=$SELECT(PXRMSEL="P":"Providers","OT"[PXRMSEL:"Teams",1:"Locations")
+42 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Combined report:",22)
+43 IF PXRMFCMB="Y"
IF PXRMLCMB="Y"
SET TEXT="Combined Facility and Combined "_LIT
+44 IF PXRMFCMB="Y"
IF PXRMLCMB="N"
SET TEXT="Combined Facility by Individual "_LIT
+45 IF PXRMLCMB="Y"
IF PXRMFCMB="N"
SET TEXT="Combined "_LIT
+46 IF PXRMTCMB="Y"
SET TEXT="Combined "_LIT
+47 SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_TEXT
SET CNT=CNT+1
+48 SET PLSTCRIT(CNT)=U_3
SET CNT=CNT+1
End DoDot:1
+49 IF PXRMREP="S"
IF "IRT"[PXRMTOT
IF "IR"'[PXRMSEL
Begin DoDot:1
+50 NEW LIT1,LIT2,LIT3,TEXT
+51 DO LIT^PXRMXD
+52 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Summary report:",22)
+53 IF PXRMTOT="I"
SET TEXT=LIT1
+54 IF PXRMTOT="R"
SET TEXT=LIT2
+55 IF PXRMTOT="T"
SET TEXT=LIT3
+56 SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_TEXT
SET CNT=CNT+1
+57 SET PLSTCRIT(CNT)=U_3
SET CNT=CNT+1
End DoDot:1
+58 IF $DATA(PXRMSCAT)
IF PXRMSCAT]""
IF PXRMFD="P"
DO OSCAT(PXRMSCAT,PSTART,.CNT,.PLSTCRIT)
+59 NEW CHECK,CNT,NODE,STR
+60 SET CNT=0
FOR
SET CNT=$ORDER(PLSTCRIT(CNT))
IF CNT'>0
QUIT
Begin DoDot:1
+61 SET NODE=$GET(PLSTCRIT(CNT))
SET CHECK=$PIECE(NODE,U,2)
SET STR=$PIECE(NODE,U)
+62 IF CHECK>0
DO CHECK(CHECK)
IF STR=""
QUIT
+63 WRITE !,STR
End DoDot:1
+64 WRITE !,UNDL,!
+65 QUIT
+66 ;
+67 ;Display selected teams/providers
DISP(CNT,PLSTCRIT) ;
+1 NEW IC
+2 SET IC=""
+3 ;IHS/MSC/MGH PATCH 1001 Added "D" for IHS provider
+4 IF PXRMSEL="P"!(PXRMSEL="D")
FOR
SET IC=$ORDER(PXRMPRV(IC))
IF IC=""
QUIT
Begin DoDot:1
+5 IF IC=1
SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$PIECE(PXRMPRV(IC),U,2)
SET CNT=CNT+1
+6 IF IC>1
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMPRV(IC),U,2)
SET CNT=CNT+1
+7 SET PLSTCRIT(CNT)=U_3
SET CNT=CNT+1
End DoDot:1
+8 IF PXRMSEL="T"
FOR
SET IC=$ORDER(PXRMPCM(IC))
IF IC=""
QUIT
Begin DoDot:1
+9 IF IC=1
SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$PIECE(PXRMPCM(IC),U,2)
SET CNT=CNT+1
+10 IF IC>1
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMPCM(IC),U,2)
SET CNT=CNT+1
+11 SET PLSTCRIT(CNT)=U_3
SET CNT=CNT+1
End DoDot:1
+12 IF PXRMSEL="O"
FOR
SET IC=$ORDER(PXRMOTM(IC))
IF IC=""
QUIT
Begin DoDot:1
+13 IF IC=1
SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$PIECE(PXRMOTM(IC),U,3)
SET CNT=CNT+1
+14 IF IC>1
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMOTM(IC),U,2)
SET CNT=CNT+1
+15 SET PLSTCRIT(CNT)=U_3
SET CNT=CNT+1
End DoDot:1
+16 IF PXRMSEL="I"
FOR
SET IC=$ORDER(PXRMPAT(IC))
IF IC=""
QUIT
Begin DoDot:1
+17 IF IC=1
SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$PIECE(PXRMPAT(IC),U,2)
SET CNT=CNT+1
+18 IF IC>1
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMPAT(IC),U,2)
SET CNT=CNT+1
+19 SET PLSTCRIT(CNT)=U_3
SET CNT=CNT+1
End DoDot:1
+20 IF PXRMSEL="R"
FOR
SET IC=$ORDER(PXRMLIST(IC))
IF IC=""
QUIT
Begin DoDot:1
+21 IF IC=1
SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$PIECE(PXRMLIST(IC),U,2)
SET CNT=CNT+1
+22 IF IC>1
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMLIST(IC),U,2)
SET CNT=CNT+1
+23 SET PLSTCRIT(CNT)=U_3
SET CNT=CNT+1
End DoDot:1
+24 IF PXRMSEL="L"
Begin DoDot:1
+25 IF $EXTRACT(PXRMLCSC)="H"
FOR
SET IC=$ORDER(^XTMP(PXRMXTMP,"HLOC",IC))
IF IC=""
QUIT
Begin DoDot:2
+26 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(^XTMP(PXRMXTMP,"HLOC",IC),U,2)
SET CNT=CNT+1
+27 SET PLSTCRIT(CNT)=U_3
SET CNT=CNT+1
End DoDot:2
+28 IF $EXTRACT(PXRMLCSC)="C"
FOR
SET IC=$ORDER(PXRMCS(IC))
IF IC=""
QUIT
Begin DoDot:2
+29 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMCS(IC),U,1)_" "_$PIECE(PXRMCS(IC),U,3)
SET CNT=CNT+1
+30 SET PLSTCRIT(CNT)=U_3
SET CNT=CNT+1
+31 IF PXRMCCS="I"
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_"Report by Individual Clinic(s)"
SET CNT=CNT+1
+32 IF PXRMCCS="B"
SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_"Report by Clinic Stops and Individual Clinic(s)"
SET CNT=CNT+1
End DoDot:2
+33 IF $EXTRACT(PXRMLCSC)="G"
FOR
SET IC=$ORDER(PXRMCGRP(IC))
IF IC=""
QUIT
Begin DoDot:2
+34 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMCGRP(IC),U,2)
SET CNT=CNT+1
+35 SET PLSTCRIT(CNT)=U_3
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+36 QUIT
+37 ;
+38 ;Output the service categories
OSCAT(SCL,PSTART,CNT,PLSTCRIT) ;
+1 NEW IC,CSTART,EM,SC,SCTEXT
+2 SET CSTART=PSTART+3
+3 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Service categories:",22)_SCL
SET CNT=CNT+1
+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 SET PLSTCRIT(CNT)=U_3
SET CNT=CNT+1
+8 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",CSTART)_SC_" - "_SCTEXT
SET CNT=CNT+1
End DoDot:1
+9 QUIT
+10 ;
+11 ;If necessary, write the header
COL(NEWPAGE) ;
+1 IF NEWPAGE
Begin DoDot:1
+2 IF PXRMTABS="N"
DO PAGE
+3 IF PXRMTABS="Y"
WRITE !!
End DoDot:1
IF DONE
QUIT
+4 DO CHECK(0)
IF DONE
QUIT
+5 DO HEAD(0)
+6 SET HEAD=0
+7 IF PXRMTABS="Y"
QUIT
+8 IF PXRMREP="D"
Begin DoDot:1
+9 NEW PNAM
+10 SET PNAM=$PIECE(PXRMREM(1),U,4)
IF PNAM=""
SET PNAM=$PIECE(PXRMREM(1),U,2)
+11 WRITE !!,PNAM,": ",COUNT
+12 IF COUNT>1
WRITE " patients have the reminder "_PXRMTX
+13 IF COUNT=1
WRITE " patient has the reminder "_PXRMTX
End DoDot:1
+14 NEW IC
FOR IC=0:1:2
WRITE !,?PXRMT(IC),PXRMH(IC)
+15 QUIT
+16 ;
+17 ;form feed to new page
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 IF $DATA(IOF)&(PAGE>0)
WRITE @IOF
+6 SET PAGE=PAGE+1
SET FIRST=0
+7 IF $EXTRACT(IOST,1,2)="C-"
IF IO=IO(0)
WRITE @IOF
+8 IF '$TEST
WRITE !
+9 NEW TEMP,TEXTLEN
+10 SET TEMP=$$NOW^XLFDT
SET TEMP=$$FMTE^XLFDT(TEMP,"P")
+11 SET TEMP=TEMP_" Page "_PAGE
+12 SET TEXTLEN=$LENGTH(TEMP)
+13 WRITE ?(IOM-TEXTLEN),TEMP
+14 SET TEXTLEN=$LENGTH(PXRMOPT)
+15 IF TEXTLEN>0
Begin DoDot:1
+16 WRITE !!
+17 WRITE ?((IOM-TEXTLEN)/2),PXRMOPT
End DoDot:1
+18 QUIT
+19 ;
+20 ;count of patients in sample
TOTAL ;
+1 NEW LIT,PERAPPL,PERDONE,PERDUE,PERCENT
+2 ;determine percentages for detail reports
+3 IF PXRMREP="D"
IF PXRMPER="1"
Begin DoDot:1
+4 SET PERCENT=$$DOPER(TOTAL,APPL,COUNT)
+5 SET PERAPPL=$PIECE(PERCENT,U)
SET PERDUE=$PIECE(PERCENT,U,2)
SET PERDONE=$PIECE(PERCENT,U,3)
End DoDot:1
+6 ;delimited reports
+7 IF PXRMTABS="Y"
Begin DoDot:1
+8 IF PXRMREP="D"
Begin DoDot:2
+9 IF PXRMPER="1"
WRITE !,"0"_SEP_"PATIENTS"_SEP_TOTAL_SEP_"APPLICABLE"_SEP_APPL_SEP_"%APPL"_SEP_PERAPPL_SEP_"%DUE"_SEP_PERDUE_SEP_"%DONE"_SEP_PERDONE
QUIT
+10 WRITE !,"0"_SEP_"PATIENTS"_SEP_TOTAL_SEP_"APPLICABLE"_SEP_APPL
End DoDot:2
QUIT
+11 IF PXRMREP="S"
WRITE !,"0"_SEP_"PATIENTS"_SEP_TOTAL_SEP_SEP_$TRANSLATE(SUB,SEP,"_")
QUIT
End DoDot:1
QUIT
+12 ;
+13 IF (PXRMRT="PXRMX")!(PXRMREP="S")
WRITE !
+14 ;S LIT=" patient."
+15 ;I TOTAL>1 S LIT=" patients."
+16 SET LIT=$SELECT(TOTAL=0:" patients.",TOTAL=1:" patient.",1:" patients.")
+17 WRITE !,"Report run on "_TOTAL_LIT
+18 IF PXRMREP="D"
Begin DoDot:1
+19 SET LIT=$SELECT(APPL=0:" patients.",APPL=1:" patient.",1:" patients.")
+20 WRITE !,"Applicable to "_APPL_LIT
+21 IF PXRMPER="1"
Begin DoDot:2
+22 WRITE !,"%Applicable "_PERAPPL
+23 WRITE !,"%Due "_PERDUE
+24 WRITE !,"%Done "_PERDONE
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
+27 ;Null report prints if no patients found
NULL IF PXRMSEL="L"
Begin DoDot:1
+1 IF PXRMFD="P"
WRITE !!,"No patient visits found"
+2 IF PXRMFD="A"
WRITE !!,"No patient admissions found"
+3 IF PXRMFD="C"
WRITE !!,"No current inpatient found"
+4 IF PXRMFD="F"
WRITE !!,"No patient appointments found"
End DoDot:1
+5 IF PXRMSEL="P"
WRITE !!,"No patients found for provider(s) selected"
+6 ;IHS/MSC/MGH Patch 1001 added for IHS providers
+7 IF PXRMSEL="D"
WRITE !!,"No patients found for provider(s) selected"
+8 IF "OT"[PXRMSEL
WRITE !!,"No patients found for team(s) selected"
+9 QUIT
+10 ;
+11 ;Null report if no patients due/satisfied - detailed report only
NONE DO PAGE
+1 DO HEAD(0)
+2 WRITE !!,"No patients with reminders "_PXRMTX
+3 QUIT
+4 ;
SPACER(TEXT,LENGTH) ;
+1 QUIT
+2 ;
+3 ;Check for page throw
CHECK(CNT) ;
+1 IF PXRMTABS="N"
IF $Y>(IOSL-BMARG-CNT)
DO PAGE
+2 QUIT
