Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMXGPR

PXRMXGPR.m

Go to the documentation of this file.
  1. PXRMXGPR ; SLC/PJH - Reminder Due print calls ;07/17/2009
  1. ;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
  1. ;
  1. ;Called from PXRMXPR
  1. ;
  1. DOPER(TOTAL,APPL,DUE) ;
  1. N PERAPPL,PERDONE,PERDUE
  1. I APPL=0 Q "0^0^0"
  1. S PERAPPL=(APPL/TOTAL)*100 I $P(PERAPPL,".",2)>4 S PERAPPL=PERAPPL+1
  1. S PERDUE=(DUE/APPL)*100 I $P(PERDUE,".",2)>4 S PERDUE=PERDUE+1
  1. S PERDUE=$P(PERDUE,"."),PERAPPL=$P(PERAPPL,".")
  1. S PERDONE=$S(PERDUE=0:100,1:(100-PERDUE))
  1. Q PERAPPL_U_PERDUE_U_PERDONE
  1. ;
  1. ;Print Selection criteria
  1. I SUB="TOTAL" N NAM S NAM="TOTAL REPORT"
  1. I PXRMTABS="Y" D Q
  1. .N FFAC,FNAM
  1. .S FNAM=NAM
  1. .I "CES"[PXRMTABC S FNAM=$TR(FNAM,SEP,"_")
  1. .I PXRMFCMB="N","LT"[PXRMSEL D Q
  1. ..S FFAC=$TR(FACPNAME,SEP,"_")
  1. ..W !,"0"_SEP_FFAC_"_"_FNAM_SEP_SEP
  1. .I PXRMFCMB="N","LT"'[PXRMSEL W !,"0"_SEP_FNAM_SEP_SEP Q
  1. .I PXRMFCMB="Y" W !,"0"_SEP_"COMBINED_REPORT_"_FNAM_SEP_SEP Q
  1. I "LT"[PXRMSEL D
  1. .I PXRMFCMB="N" W !,?PSTART,"Facility: ",FACPNAME Q
  1. .W !,?PSTART,"Combined Report: "
  1. .N FACN,LENGTH,TEXT
  1. .S FACN=0,LENGTH=17+PSTART
  1. .F S FACN=$O(PXRMFACN(FACN)) Q:'FACN D
  1. ..S TEXT=$P(PXRMFACN(FACN),U)_" ("_FACN_")"
  1. ..I $O(PXRMFACN(FACN)) S TEXT=TEXT_", "
  1. ..I (LENGTH+$L(TEXT))>80 S LENGTH=17+PSTART W !,?(17+PSTART)
  1. ..W TEXT S LENGTH=LENGTH+$L(TEXT)
  1. I "PTO"[PXRMSEL D
  1. .I SUB="TOTAL" W !,?PSTART,NAM Q
  1. .W !,?PSTART,"Reminders "_PXRMTX_" for ",NAM
  1. I PXRMSEL="L" D
  1. .N CNT,NOUT,TEXTIN,TEXTOUT
  1. .S TEXTIN(1)="Reminders "_PXRMTX_" "_SD_" - "_NAM
  1. .I "PF"[PXRMFD S TEXTIN(1)=TEXTIN(1)_" for "_BD_" to "_ED
  1. .I PXRMFD="A" S TEXTIN(1)=TEXTIN(1)_" admissions from "_BD_" to "_ED
  1. .I PXRMFD="C" S TEXTIN(1)=TEXTIN(1)_" for current inpatients"
  1. .D FORMAT^PXRMTEXT(PSTART,75,1,.TEXTIN,.NOUT,.TEXTOUT)
  1. .F CNT=1:1:NOUT W !,TEXTOUT(CNT)
  1. I PXRMSEL="R" W !,"Patient List: "_SUB
  1. I PXRMSEL'="L" W " for ",SD
  1. W:PXRMSEL="I" !
  1. ;
  1. Q
  1. ;
  1. ;Output the provider report criteria
  1. CRIT(PSTART,PLSTCRIT) ;
  1. N CNT,RCCNT,RCDES,RICNT,RIDES,UNDL
  1. S CNT=0
  1. S UNDL=$TR($J("",79)," ","_") D LITS^PXRMXPR1
  1. S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART-8)_"Report Criteria:",CNT=CNT+1
  1. I PXRMTMP'="" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Report Title:",22)_$P(PXRMTMP,U,3),CNT=CNT+1
  1. S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Patient Sample:",22)_PXRMFLD,CNT=CNT+1
  1. I PXRMSEL'="L" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR(PXRMFLD_":",22) D DISP(.CNT,.PLSTCRIT)
  1. I PXRMSEL="L" D
  1. .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR(PXRMFLD_":",22)_DES,CNT=CNT+1
  1. .I $E(PXRMLCSC,2)'="A" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",10) D DISP(.CNT,.PLSTCRIT)
  1. I $D(PXRMRCAT) D
  1. .S RCCNT=0
  1. .F S RCCNT=$O(PXRMRCAT(RCCNT)) Q:'RCCNT D
  1. ..S RCDES=$P(PXRMRCAT(RCCNT),U,2)
  1. ..I RCCNT=1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Reminder Category:",22)_RCDES_U_6,CNT=CNT+1
  1. ..I RCCNT>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",22)_RCDES
  1. .S RICNT=0
  1. .F S RICNT=$O(PXRMREM(RICNT)) Q:'RICNT D
  1. ..S RIDES=$P(PXRMREM(RICNT),U,2)
  1. ..I RICNT=1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Individual Reminder:",22)_RIDES_U_6,CNT=CNT+1
  1. ..I RICNT>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",22)_RIDES,CNT=CNT+1
  1. S PLSTCRIT(CNT)=U_6,CNT=CNT+1
  1. I PXRMREP="D" D
  1. .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Reminder:",22)_RDES,CNT=CNT+1
  1. .;Display future appointments for Reminder Due report only
  1. .I PXRMRT="PXRMX" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_"Appointments:" D
  1. ..I PXRMFUT="Y" S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$$LJ^XLFSTR(" ",32-$L(PLSTCRIT(CNT)))_"All Future Appointments",CNT=CNT+1
  1. ..I PXRMFUT="N" S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$$LJ^XLFSTR(" ",32-$L(PLSTCRIT(CNT)))_"Next Appointment only",CNT=CNT+1
  1. I PXRMSEL="P" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("All/Primary:",22)_CDES,CNT=CNT+1
  1. I PXRMSEL="L" D S CNT=CNT+1
  1. .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Date Range:",22)
  1. .I "PAF"[PXRMFD S PLSTCRIT(CNT)=PLSTCRIT(CNT)_BD_" to "_ED Q
  1. .I PXRMFD="C" S PLSTCRIT(CNT)=PLSTCRIT(CNT)_"not applicable" Q
  1. S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Effective Due Date:",22)_SD,CNT=CNT+1
  1. S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Date run:",22)_RD,CNT=CNT+1
  1. I PXRMTMP'="" D
  1. .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Template Name:",22)_$P(PXRMTMP,U,2),CNT=CNT+1
  1. .I PXRMUSER S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Requested by:",22)_$$GET1^DIQ(200,DUZ,.01)_U_3,CNT=CNT+1
  1. I (PXRMFCMB="Y")!(PXRMLCMB="Y")!(PXRMTCMB="Y") D
  1. .N LIT,TEXT
  1. .S LIT=$S(PXRMSEL="P":"Providers","OT"[PXRMSEL:"Teams",1:"Locations")
  1. .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Combined report:",22)
  1. .I PXRMFCMB="Y",PXRMLCMB="Y" S TEXT="Combined Facility and Combined "_LIT
  1. .I PXRMFCMB="Y",PXRMLCMB="N" S TEXT="Combined Facility by Individual "_LIT
  1. .I PXRMLCMB="Y",PXRMFCMB="N" S TEXT="Combined "_LIT
  1. .I PXRMTCMB="Y" S TEXT="Combined "_LIT
  1. .S PLSTCRIT(CNT)=PLSTCRIT(CNT)_TEXT,CNT=CNT+1
  1. .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
  1. I PXRMREP="S","IRT"[PXRMTOT,"IR"'[PXRMSEL D
  1. .N LIT1,LIT2,LIT3,TEXT
  1. .D LIT^PXRMXD
  1. .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Summary report:",22)
  1. .I PXRMTOT="I" S TEXT=LIT1
  1. .I PXRMTOT="R" S TEXT=LIT2
  1. .I PXRMTOT="T" S TEXT=LIT3
  1. .S PLSTCRIT(CNT)=PLSTCRIT(CNT)_TEXT,CNT=CNT+1
  1. .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
  1. I $D(PXRMSCAT),PXRMSCAT]"",PXRMFD="P" D OSCAT(PXRMSCAT,PSTART,.CNT,.PLSTCRIT)
  1. N CHECK,CNT,NODE,STR
  1. S CNT=0 F S CNT=$O(PLSTCRIT(CNT)) Q:CNT'>0 D
  1. .S NODE=$G(PLSTCRIT(CNT)),CHECK=$P(NODE,U,2),STR=$P(NODE,U)
  1. .I CHECK>0 D CHECK(CHECK) I STR="" Q
  1. .W !,STR
  1. W !,UNDL,!
  1. Q
  1. ;
  1. ;Display selected teams/providers
  1. DISP(CNT,PLSTCRIT) ;
  1. N IC
  1. S IC=""
  1. I PXRMSEL="P" F S IC=$O(PXRMPRV(IC)) Q:IC="" D
  1. .I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMPRV(IC),U,2),CNT=CNT+1
  1. .I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMPRV(IC),U,2),CNT=CNT+1
  1. .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
  1. I PXRMSEL="T" F S IC=$O(PXRMPCM(IC)) Q:IC="" D
  1. .I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMPCM(IC),U,2),CNT=CNT+1
  1. .I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMPCM(IC),U,2),CNT=CNT+1
  1. .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
  1. I PXRMSEL="O" F S IC=$O(PXRMOTM(IC)) Q:IC="" D
  1. .I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMOTM(IC),U,3),CNT=CNT+1
  1. .I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMOTM(IC),U,2),CNT=CNT+1
  1. .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
  1. I PXRMSEL="I" F S IC=$O(PXRMPAT(IC)) Q:IC="" D
  1. .I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMPAT(IC),U,2),CNT=CNT+1
  1. .I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMPAT(IC),U,2),CNT=CNT+1
  1. .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
  1. I PXRMSEL="R" F S IC=$O(PXRMLIST(IC)) Q:IC="" D
  1. .I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMLIST(IC),U,2),CNT=CNT+1
  1. .I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMLIST(IC),U,2),CNT=CNT+1
  1. .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
  1. I PXRMSEL="L" D
  1. .I $E(PXRMLCSC)="H" F S IC=$O(^XTMP(PXRMXTMP,"HLOC",IC)) Q:IC="" D
  1. ..S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(^XTMP(PXRMXTMP,"HLOC",IC),U,2),CNT=CNT+1
  1. ..S PLSTCRIT(CNT)=U_3,CNT=CNT+1
  1. .I $E(PXRMLCSC)="C" F S IC=$O(PXRMCS(IC)) Q:IC="" D
  1. ..S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMCS(IC),U,1)_" "_$P(PXRMCS(IC),U,3),CNT=CNT+1
  1. ..S PLSTCRIT(CNT)=U_3,CNT=CNT+1
  1. ..I PXRMCCS="I" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_"Report by Individual Clinic(s)",CNT=CNT+1
  1. ..I PXRMCCS="B" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_"Report by Clinic Stops and Individual Clinic(s)",CNT=CNT+1
  1. .I $E(PXRMLCSC)="G" F S IC=$O(PXRMCGRP(IC)) Q:IC="" D
  1. ..S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMCGRP(IC),U,2),CNT=CNT+1
  1. ..S PLSTCRIT(CNT)=U_3,CNT=CNT+1
  1. Q
  1. ;
  1. ;Output the service categories
  1. OSCAT(SCL,PSTART,CNT,PLSTCRIT) ;
  1. N IC,CSTART,EM,SC,SCTEXT
  1. S CSTART=PSTART+3
  1. S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Service categories:",22)_SCL,CNT=CNT+1
  1. F IC=1:1:$L(SCL,",") D
  1. .S SC=$P(SCL,",",IC)
  1. .S SCTEXT=$$EXTERNAL^DILFD(9000010,.07,"",SC,.EM)
  1. .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
  1. .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",CSTART)_SC_" - "_SCTEXT,CNT=CNT+1
  1. Q
  1. ;
  1. ;If necessary, write the header
  1. COL(NEWPAGE) ;
  1. I NEWPAGE D Q:DONE
  1. .I PXRMTABS="N" D PAGE
  1. .I PXRMTABS="Y" W !!
  1. D CHECK(0) Q:DONE
  1. D HEAD(0)
  1. S HEAD=0
  1. I PXRMTABS="Y" Q
  1. I PXRMREP="D" D
  1. .N PNAM
  1. .S PNAM=$P(PXRMREM(1),U,4) I PNAM="" S PNAM=$P(PXRMREM(1),U,2)
  1. .W !!,PNAM,": ",COUNT
  1. .W:COUNT>1 " patients have the reminder "_PXRMTX
  1. .W:COUNT=1 " patient has the reminder "_PXRMTX
  1. N IC F IC=0:1:2 W !,?PXRMT(IC),PXRMH(IC)
  1. Q
  1. ;
  1. ;form feed to new page
  1. PAGE I ($E(IOST,1,2)="C-")&(IO=IO(0))&(PAGE>0) D
  1. .S DIR(0)="E"
  1. .W !
  1. .D ^DIR K DIR
  1. I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) S DONE=1 Q
  1. W:$D(IOF)&(PAGE>0) @IOF
  1. S PAGE=PAGE+1,FIRST=0
  1. I $E(IOST,1,2)="C-",IO=IO(0) W @IOF
  1. E W !
  1. N TEMP,TEXTLEN
  1. S TEMP=$$NOW^XLFDT,TEMP=$$FMTE^XLFDT(TEMP,"P")
  1. S TEMP=TEMP_" Page "_PAGE
  1. S TEXTLEN=$L(TEMP)
  1. W ?(IOM-TEXTLEN),TEMP
  1. S TEXTLEN=$L(PXRMOPT)
  1. I TEXTLEN>0 D
  1. .W !!
  1. .W ?((IOM-TEXTLEN)/2),PXRMOPT
  1. Q
  1. ;
  1. ;count of patients in sample
  1. TOTAL ;
  1. N LIT,PERAPPL,PERDONE,PERDUE,PERCENT
  1. ;determine percentages for detail reports
  1. I PXRMREP="D",PXRMPER="1" D
  1. .S PERCENT=$$DOPER(TOTAL,APPL,COUNT)
  1. .S PERAPPL=$P(PERCENT,U),PERDUE=$P(PERCENT,U,2),PERDONE=$P(PERCENT,U,3)
  1. ;delimited reports
  1. I PXRMTABS="Y" D Q
  1. .I PXRMREP="D" D Q
  1. ..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
  1. ..W !,"0"_SEP_"PATIENTS"_SEP_TOTAL_SEP_"APPLICABLE"_SEP_APPL
  1. .I PXRMREP="S" W !,"0"_SEP_"PATIENTS"_SEP_TOTAL_SEP_SEP_$TR(SUB,SEP,"_") Q
  1. ;
  1. I (PXRMRT="PXRMX")!(PXRMREP="S") W !
  1. ;S LIT=" patient."
  1. ;I TOTAL>1 S LIT=" patients."
  1. S LIT=$S(TOTAL=0:" patients.",TOTAL=1:" patient.",1:" patients.")
  1. W !,"Report run on "_TOTAL_LIT
  1. I PXRMREP="D" D
  1. .S LIT=$S(APPL=0:" patients.",APPL=1:" patient.",1:" patients.")
  1. .W !,"Applicable to "_APPL_LIT
  1. .I PXRMPER="1" D
  1. ..W !,"%Applicable "_PERAPPL
  1. ..W !,"%Due "_PERDUE
  1. ..W !,"%Done "_PERDONE
  1. Q
  1. ;
  1. ;Null report prints if no patients found
  1. NULL I PXRMSEL="L" D
  1. .I PXRMFD="P" W !!,"No patient visits found"
  1. .I PXRMFD="A" W !!,"No patient admissions found"
  1. .I PXRMFD="C" W !!,"No current inpatient found"
  1. .I PXRMFD="F" W !!,"No patient appointments found"
  1. I PXRMSEL="P" W !!,"No patients found for provider(s) selected"
  1. I "OT"[PXRMSEL W !!,"No patients found for team(s) selected"
  1. Q
  1. ;
  1. ;Null report if no patients due/satisfied - detailed report only
  1. NONE D PAGE
  1. D HEAD(0)
  1. W !!,"No patients with reminders "_PXRMTX
  1. Q
  1. ;
  1. SPACER(TEXT,LENGTH) ;
  1. Q
  1. ;
  1. ;Check for page throw
  1. CHECK(CNT) ;
  1. I PXRMTABS="N",$Y>(IOSL-BMARG-CNT) D PAGE
  1. Q