- PXRMXGPR ; SLC/PJH - Reminder Due print calls ;07/17/2009
- ;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
- ;
- ;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=""
- I PXRMSEL="P" 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"
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXGPR 10662 printed Feb 18, 2025@23:16:34 Page 2
- PXRMXGPR ; SLC/PJH - Reminder Due print calls ;07/17/2009
- +1 ;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
- +2 ;
- +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 IF PXRMSEL="P"
- FOR
- SET IC=$ORDER(PXRMPRV(IC))
- if IC=""
- QUIT
- Begin DoDot:1
- +4 IF IC=1
- SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$PIECE(PXRMPRV(IC),U,2)
- SET CNT=CNT+1
- +5 IF IC>1
- SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMPRV(IC),U,2)
- SET CNT=CNT+1
- +6 SET PLSTCRIT(CNT)=U_3
- SET CNT=CNT+1
- End DoDot:1
- +7 IF PXRMSEL="T"
- FOR
- SET IC=$ORDER(PXRMPCM(IC))
- if IC=""
- QUIT
- Begin DoDot:1
- +8 IF IC=1
- SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$PIECE(PXRMPCM(IC),U,2)
- SET CNT=CNT+1
- +9 IF IC>1
- SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMPCM(IC),U,2)
- SET CNT=CNT+1
- +10 SET PLSTCRIT(CNT)=U_3
- SET CNT=CNT+1
- End DoDot:1
- +11 IF PXRMSEL="O"
- FOR
- SET IC=$ORDER(PXRMOTM(IC))
- if IC=""
- QUIT
- Begin DoDot:1
- +12 IF IC=1
- SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$PIECE(PXRMOTM(IC),U,3)
- SET CNT=CNT+1
- +13 IF IC>1
- SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMOTM(IC),U,2)
- SET CNT=CNT+1
- +14 SET PLSTCRIT(CNT)=U_3
- SET CNT=CNT+1
- End DoDot:1
- +15 IF PXRMSEL="I"
- FOR
- SET IC=$ORDER(PXRMPAT(IC))
- if IC=""
- QUIT
- Begin DoDot:1
- +16 IF IC=1
- SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$PIECE(PXRMPAT(IC),U,2)
- SET CNT=CNT+1
- +17 IF IC>1
- SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMPAT(IC),U,2)
- SET CNT=CNT+1
- +18 SET PLSTCRIT(CNT)=U_3
- SET CNT=CNT+1
- End DoDot:1
- +19 IF PXRMSEL="R"
- FOR
- SET IC=$ORDER(PXRMLIST(IC))
- if IC=""
- QUIT
- Begin DoDot:1
- +20 IF IC=1
- SET PLSTCRIT(CNT)=PLSTCRIT(CNT)_$PIECE(PXRMLIST(IC),U,2)
- SET CNT=CNT+1
- +21 IF IC>1
- SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMLIST(IC),U,2)
- SET CNT=CNT+1
- +22 SET PLSTCRIT(CNT)=U_3
- SET CNT=CNT+1
- End DoDot:1
- +23 IF PXRMSEL="L"
- Begin DoDot:1
- +24 IF $EXTRACT(PXRMLCSC)="H"
- FOR
- SET IC=$ORDER(^XTMP(PXRMXTMP,"HLOC",IC))
- if IC=""
- QUIT
- Begin DoDot:2
- +25 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(^XTMP(PXRMXTMP,"HLOC",IC),U,2)
- SET CNT=CNT+1
- +26 SET PLSTCRIT(CNT)=U_3
- SET CNT=CNT+1
- End DoDot:2
- +27 IF $EXTRACT(PXRMLCSC)="C"
- FOR
- SET IC=$ORDER(PXRMCS(IC))
- if IC=""
- QUIT
- Begin DoDot:2
- +28 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMCS(IC),U,1)_" "_$PIECE(PXRMCS(IC),U,3)
- SET CNT=CNT+1
- +29 SET PLSTCRIT(CNT)=U_3
- SET CNT=CNT+1
- +30 IF PXRMCCS="I"
- SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_"Report by Individual Clinic(s)"
- SET CNT=CNT+1
- +31 IF PXRMCCS="B"
- SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_"Report by Clinic Stops and Individual Clinic(s)"
- SET CNT=CNT+1
- End DoDot:2
- +32 IF $EXTRACT(PXRMLCSC)="G"
- FOR
- SET IC=$ORDER(PXRMCGRP(IC))
- if IC=""
- QUIT
- Begin DoDot:2
- +33 SET PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$PIECE(PXRMCGRP(IC),U,2)
- SET CNT=CNT+1
- +34 SET PLSTCRIT(CNT)=U_3
- SET CNT=CNT+1
- End DoDot:2
- End DoDot:1
- +35 QUIT
- +36 ;
- +37 ;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 IF "OT"[PXRMSEL
- WRITE !!,"No patients found for team(s) selected"
- +7 QUIT
- +8 ;
- +9 ;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