- 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 Feb 18, 2025@23:16:38 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 ;