PXRMXPR1 ; SLC/AGP - Print Reminder Due report carryover code. ;01/05/2006
;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
;
;Patient list display
N CNT,CNT1,COUNT,TEXT
;Count patients in list
S COUNT=+$O(^PXRMXP(810.5,PXRMLIS1,30,"A"),-1)
;
I COUNT=0 W !!!,"No patients due. Patient List not created" Q
W !!!,"Patient List "_$P($G(^PXRMXP(810.5,PXRMLIS1,0)),U)_" created by "_$$GET1^DIQ(200,DUZ,.01)_" on "_$$FMTE^XLFDT($P($G(^PXRMXP(810.5,PXRMLIS1,0)),U,4),1)
W !!,"List contains "_COUNT_" patients, report run on "_TTOTAL_" patients."
;
;Screen out formatting lines and second piece of criteria array
S (CNT,CNT1)=0 F S CNT=$O(PLSTCRIT(CNT)) Q:CNT'>0 D
.I $P($G(PLSTCRIT(CNT)),U)="",$P($G(PLSTCRIT(CNT)),U,2)>0 Q
.S CNT1=CNT1+1 S TEXT(CNT1)=$P($G(PLSTCRIT(CNT)),U)
;Store Report Criteria in the document multiple of the patient list
F CNT1=1:1:CNT1 S ^PXRMXP(810.5,PXRMLIS1,200,CNT1,0)=TEXT(CNT1)
S ^PXRMXP(810.5,PXRMLIS1,200,0)=U_"810.51"_U_CNT1_U_CNT1
Q
;
;Set up literals for display
LITS ;
I PXRMSEL="I" S PXRMFLD="Individual Patients"
I PXRMSEL="R" S PXRMFLD="Patient List"
I PXRMSEL="P" S PXRMFLD="PCMM Provider"
I PXRMSEL="O" S PXRMFLD="OE/RR Team"
I PXRMSEL="T" S PXRMFLD="PCMM Team"
I PXRMSEL="L" D
.S PXRMFLD="Location"
.I $P(PXRMLCSC,U)="HS" S DES="Selected Hospital Locations"
.I $P(PXRMLCSC,U)="HA" S DES="All Outpatient Locations"
.I $P(PXRMLCSC,U)="HAI" S DES="All Inpatient Locations"
.I $P(PXRMLCSC,U)="CS" S DES="Selected Clinic Stops"
.I $P(PXRMLCSC,U)="CA" S DES="All Clinic Stops"
.I $P(PXRMLCSC,U)="GS" S DES="Selected Clinic Groups"
.I PXRMFD="P" S DES=DES_" (Prior Encounters)"
.I PXRMFD="F" S DES=DES_" (Future Appoints.)"
.I PXRMFD="A" S DES=DES_" (Admissions)"
.I PXRMFD="C" S DES=DES_" (Current Inpatients)"
I PXRMSEL="P" D
.I PXRMPRIM="A" S CDES="All patients on list"
.I PXRMPRIM="P" S CDES="Primary care assigned patients only"
Q
;
;Report missed locations if report is partially successful
MISSED(PSTART,MISSED) ;
;Delimited report from template
I PXRMTABS="Y",PXRMTMP'="" D Q
.W !!?PSTART,"The following had no patients selected",!
.N SUB
.S SUB=""
.F S SUB=$O(MISSED(SUB)) Q:SUB="" D
..W !?PSTART+10,SUB
;Other reports
N LIT,SUB
D CHECK^PXRMXGPR(5) Q:DONE
S LIT=PXRMFLD
I PXRMSEL="L",$E(PXRMLCSC)="G" S LIT="Clinic Group"
W !!?PSTART,"The following ",LIT,"(s) had no patients selected",!
S SUB=""
F S SUB=$O(MISSED(SUB)) Q:SUB="" D
.D CHECK^PXRMXGPR(3) Q:DONE
.W !?PSTART+10,SUB
Q
;
;Build array of locations/providers/teams with no patients
NOPATS(MISSED) ;
N DATA,IC,LTYPE,MARK
S IC=""
I PXRMSEL="P" D Q
. F S IC=$O(PXRMPRV(IC)) Q:IC="" D
.. S DATA=PXRMPRV(IC)
.. D TEST(DATA,$P(DATA,U,1),.MISSED)
I PXRMSEL="T" D
. F S IC=$O(PXRMPCM(IC)) Q:IC="" D
.. S DATA=PXRMPCM(IC)
.. D TEST(DATA,$P(DATA,U,1),.MISSED)
I PXRMSEL="O" D
. F S IC=$O(PXRMOTM(IC)) Q:IC="" D
.. S DATA=PXRMOTM(IC)
.. D TEST(DATA,$P(DATA,U,1),.MISSED)
S LTYPE=$E($G(PXRMLCSC))
I LTYPE="H" D
. F S IC=$O(^XTMP(PXRMXTMP,"HLOC",IC)) Q:IC="" D
.. S DATA=^XTMP(PXRMXTMP,"HLOC",IC)
.. D TEST(DATA,IC,.MISSED)
I LTYPE="C" D
. F S IC=$O(PXRMCS(IC)) Q:IC="" D
.. S DATA=PXRMCS(IC)
.. D TEST(DATA,$P(DATA,U,3),.MISSED)
I LTYPE="G" D
. F S IC=$O(PXRMCGRP(IC)) Q:IC="" D
.. S DATA=PXRMCGRP(IC)
.. D TEST(DATA,$P(DATA,U,1),.MISSED)
Q
;
;Check for match on location
TEST(DATA,IEN,MISSED) ;
N SUB
I $D(^XTMP(PXRMXTMP,"MARKED AS FOUND",IEN)) Q
I PXRMSEL'="L" S MISSED($P(DATA,U,2))="" Q
N LTYPE
S LTYPE=$E(PXRMLCSC)
I LTYPE="H" S SUB=IEN D
. N FACNAM,FACNUM,HLOC
. S HLOC=$P(DATA,U,2) Q:HLOC=""
. S FACNUM=$$HFAC^PXRMXSL1(IEN)
. S FACNAM=$S(FACNUM="":"?",1:$P($G(PXRMFACN(FACNUM)),U,1))
. I FACNAM'="" S SUB=HLOC_" ("_FACNAM_")"
I LTYPE="C" S SUB=$P(DATA,U,1)_" "_$P(DATA,U,3)
I LTYPE="G" S SUB=$P(DATA,U,2)
S MISSED(SUB)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXPR1 3991 printed Dec 13, 2024@01:50:15 Page 2
PXRMXPR1 ; SLC/AGP - Print Reminder Due report carryover code. ;01/05/2006
+1 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+2 ;
+3 ;Patient list display
+1 NEW CNT,CNT1,COUNT,TEXT
+2 ;Count patients in list
+3 SET COUNT=+$ORDER(^PXRMXP(810.5,PXRMLIS1,30,"A"),-1)
+4 ;
+5 IF COUNT=0
WRITE !!!,"No patients due. Patient List not created"
QUIT
+6 WRITE !!!,"Patient List "_$PIECE($GET(^PXRMXP(810.5,PXRMLIS1,0)),U)_" created by "_$$GET1^DIQ(200,DUZ,.01)_" on "_$$FMTE^XLFDT($PIECE($GET(^PXRMXP(810.5,PXRMLIS1,0)),U,4),1)
+7 WRITE !!,"List contains "_COUNT_" patients, report run on "_TTOTAL_" patients."
+8 ;
+9 ;Screen out formatting lines and second piece of criteria array
+10 SET (CNT,CNT1)=0
FOR
SET CNT=$ORDER(PLSTCRIT(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(PLSTCRIT(CNT)),U)=""
IF $PIECE($GET(PLSTCRIT(CNT)),U,2)>0
QUIT
+12 SET CNT1=CNT1+1
SET TEXT(CNT1)=$PIECE($GET(PLSTCRIT(CNT)),U)
End DoDot:1
+13 ;Store Report Criteria in the document multiple of the patient list
+14 FOR CNT1=1:1:CNT1
SET ^PXRMXP(810.5,PXRMLIS1,200,CNT1,0)=TEXT(CNT1)
+15 SET ^PXRMXP(810.5,PXRMLIS1,200,0)=U_"810.51"_U_CNT1_U_CNT1
+16 QUIT
+17 ;
+18 ;Set up literals for display
LITS ;
+1 IF PXRMSEL="I"
SET PXRMFLD="Individual Patients"
+2 IF PXRMSEL="R"
SET PXRMFLD="Patient List"
+3 IF PXRMSEL="P"
SET PXRMFLD="PCMM Provider"
+4 IF PXRMSEL="O"
SET PXRMFLD="OE/RR Team"
+5 IF PXRMSEL="T"
SET PXRMFLD="PCMM Team"
+6 IF PXRMSEL="L"
Begin DoDot:1
+7 SET PXRMFLD="Location"
+8 IF $PIECE(PXRMLCSC,U)="HS"
SET DES="Selected Hospital Locations"
+9 IF $PIECE(PXRMLCSC,U)="HA"
SET DES="All Outpatient Locations"
+10 IF $PIECE(PXRMLCSC,U)="HAI"
SET DES="All Inpatient Locations"
+11 IF $PIECE(PXRMLCSC,U)="CS"
SET DES="Selected Clinic Stops"
+12 IF $PIECE(PXRMLCSC,U)="CA"
SET DES="All Clinic Stops"
+13 IF $PIECE(PXRMLCSC,U)="GS"
SET DES="Selected Clinic Groups"
+14 IF PXRMFD="P"
SET DES=DES_" (Prior Encounters)"
+15 IF PXRMFD="F"
SET DES=DES_" (Future Appoints.)"
+16 IF PXRMFD="A"
SET DES=DES_" (Admissions)"
+17 IF PXRMFD="C"
SET DES=DES_" (Current Inpatients)"
End DoDot:1
+18 IF PXRMSEL="P"
Begin DoDot:1
+19 IF PXRMPRIM="A"
SET CDES="All patients on list"
+20 IF PXRMPRIM="P"
SET CDES="Primary care assigned patients only"
End DoDot:1
+21 QUIT
+22 ;
+23 ;Report missed locations if report is partially successful
MISSED(PSTART,MISSED) ;
+1 ;Delimited report from template
+2 IF PXRMTABS="Y"
IF PXRMTMP'=""
Begin DoDot:1
+3 WRITE !!?PSTART,"The following had no patients selected",!
+4 NEW SUB
+5 SET SUB=""
+6 FOR
SET SUB=$ORDER(MISSED(SUB))
if SUB=""
QUIT
Begin DoDot:2
+7 WRITE !?PSTART+10,SUB
End DoDot:2
End DoDot:1
QUIT
+8 ;Other reports
+9 NEW LIT,SUB
+10 DO CHECK^PXRMXGPR(5)
if DONE
QUIT
+11 SET LIT=PXRMFLD
+12 IF PXRMSEL="L"
IF $EXTRACT(PXRMLCSC)="G"
SET LIT="Clinic Group"
+13 WRITE !!?PSTART,"The following ",LIT,"(s) had no patients selected",!
+14 SET SUB=""
+15 FOR
SET SUB=$ORDER(MISSED(SUB))
if SUB=""
QUIT
Begin DoDot:1
+16 DO CHECK^PXRMXGPR(3)
if DONE
QUIT
+17 WRITE !?PSTART+10,SUB
End DoDot:1
+18 QUIT
+19 ;
+20 ;Build array of locations/providers/teams with no patients
NOPATS(MISSED) ;
+1 NEW DATA,IC,LTYPE,MARK
+2 SET IC=""
+3 IF PXRMSEL="P"
Begin DoDot:1
+4 FOR
SET IC=$ORDER(PXRMPRV(IC))
if IC=""
QUIT
Begin DoDot:2
+5 SET DATA=PXRMPRV(IC)
+6 DO TEST(DATA,$PIECE(DATA,U,1),.MISSED)
End DoDot:2
End DoDot:1
QUIT
+7 IF PXRMSEL="T"
Begin DoDot:1
+8 FOR
SET IC=$ORDER(PXRMPCM(IC))
if IC=""
QUIT
Begin DoDot:2
+9 SET DATA=PXRMPCM(IC)
+10 DO TEST(DATA,$PIECE(DATA,U,1),.MISSED)
End DoDot:2
End DoDot:1
+11 IF PXRMSEL="O"
Begin DoDot:1
+12 FOR
SET IC=$ORDER(PXRMOTM(IC))
if IC=""
QUIT
Begin DoDot:2
+13 SET DATA=PXRMOTM(IC)
+14 DO TEST(DATA,$PIECE(DATA,U,1),.MISSED)
End DoDot:2
End DoDot:1
+15 SET LTYPE=$EXTRACT($GET(PXRMLCSC))
+16 IF LTYPE="H"
Begin DoDot:1
+17 FOR
SET IC=$ORDER(^XTMP(PXRMXTMP,"HLOC",IC))
if IC=""
QUIT
Begin DoDot:2
+18 SET DATA=^XTMP(PXRMXTMP,"HLOC",IC)
+19 DO TEST(DATA,IC,.MISSED)
End DoDot:2
End DoDot:1
+20 IF LTYPE="C"
Begin DoDot:1
+21 FOR
SET IC=$ORDER(PXRMCS(IC))
if IC=""
QUIT
Begin DoDot:2
+22 SET DATA=PXRMCS(IC)
+23 DO TEST(DATA,$PIECE(DATA,U,3),.MISSED)
End DoDot:2
End DoDot:1
+24 IF LTYPE="G"
Begin DoDot:1
+25 FOR
SET IC=$ORDER(PXRMCGRP(IC))
if IC=""
QUIT
Begin DoDot:2
+26 SET DATA=PXRMCGRP(IC)
+27 DO TEST(DATA,$PIECE(DATA,U,1),.MISSED)
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
+30 ;Check for match on location
TEST(DATA,IEN,MISSED) ;
+1 NEW SUB
+2 IF $DATA(^XTMP(PXRMXTMP,"MARKED AS FOUND",IEN))
QUIT
+3 IF PXRMSEL'="L"
SET MISSED($PIECE(DATA,U,2))=""
QUIT
+4 NEW LTYPE
+5 SET LTYPE=$EXTRACT(PXRMLCSC)
+6 IF LTYPE="H"
SET SUB=IEN
Begin DoDot:1
+7 NEW FACNAM,FACNUM,HLOC
+8 SET HLOC=$PIECE(DATA,U,2)
if HLOC=""
QUIT
+9 SET FACNUM=$$HFAC^PXRMXSL1(IEN)
+10 SET FACNAM=$SELECT(FACNUM="":"?",1:$PIECE($GET(PXRMFACN(FACNUM)),U,1))
+11 IF FACNAM'=""
SET SUB=HLOC_" ("_FACNAM_")"
End DoDot:1
+12 IF LTYPE="C"
SET SUB=$PIECE(DATA,U,1)_" "_$PIECE(DATA,U,3)
+13 IF LTYPE="G"
SET SUB=$PIECE(DATA,U,2)
+14 SET MISSED(SUB)=""
+15 QUIT
+16 ;
