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

PXRMXPR1.m

Go to the documentation of this file.
  1. PXRMXPR1 ; SLC/AGP - Print Reminder Due report carryover code. ;01/05/2006
  1. ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
  1. ;
  1. ;Patient list display
  1. N CNT,CNT1,COUNT,TEXT
  1. ;Count patients in list
  1. S COUNT=+$O(^PXRMXP(810.5,PXRMLIS1,30,"A"),-1)
  1. ;
  1. I COUNT=0 W !!!,"No patients due. Patient List not created" Q
  1. 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)
  1. W !!,"List contains "_COUNT_" patients, report run on "_TTOTAL_" patients."
  1. ;
  1. ;Screen out formatting lines and second piece of criteria array
  1. S (CNT,CNT1)=0 F S CNT=$O(PLSTCRIT(CNT)) Q:CNT'>0 D
  1. .I $P($G(PLSTCRIT(CNT)),U)="",$P($G(PLSTCRIT(CNT)),U,2)>0 Q
  1. .S CNT1=CNT1+1 S TEXT(CNT1)=$P($G(PLSTCRIT(CNT)),U)
  1. ;Store Report Criteria in the document multiple of the patient list
  1. F CNT1=1:1:CNT1 S ^PXRMXP(810.5,PXRMLIS1,200,CNT1,0)=TEXT(CNT1)
  1. S ^PXRMXP(810.5,PXRMLIS1,200,0)=U_"810.51"_U_CNT1_U_CNT1
  1. Q
  1. ;
  1. ;Set up literals for display
  1. LITS ;
  1. I PXRMSEL="I" S PXRMFLD="Individual Patients"
  1. I PXRMSEL="R" S PXRMFLD="Patient List"
  1. I PXRMSEL="P" S PXRMFLD="PCMM Provider"
  1. I PXRMSEL="O" S PXRMFLD="OE/RR Team"
  1. I PXRMSEL="T" S PXRMFLD="PCMM Team"
  1. I PXRMSEL="L" D
  1. .S PXRMFLD="Location"
  1. .I $P(PXRMLCSC,U)="HS" S DES="Selected Hospital Locations"
  1. .I $P(PXRMLCSC,U)="HA" S DES="All Outpatient Locations"
  1. .I $P(PXRMLCSC,U)="HAI" S DES="All Inpatient Locations"
  1. .I $P(PXRMLCSC,U)="CS" S DES="Selected Clinic Stops"
  1. .I $P(PXRMLCSC,U)="CA" S DES="All Clinic Stops"
  1. .I $P(PXRMLCSC,U)="GS" S DES="Selected Clinic Groups"
  1. .I PXRMFD="P" S DES=DES_" (Prior Encounters)"
  1. .I PXRMFD="F" S DES=DES_" (Future Appoints.)"
  1. .I PXRMFD="A" S DES=DES_" (Admissions)"
  1. .I PXRMFD="C" S DES=DES_" (Current Inpatients)"
  1. I PXRMSEL="P" D
  1. .I PXRMPRIM="A" S CDES="All patients on list"
  1. .I PXRMPRIM="P" S CDES="Primary care assigned patients only"
  1. Q
  1. ;
  1. ;Report missed locations if report is partially successful
  1. MISSED(PSTART,MISSED) ;
  1. ;Delimited report from template
  1. I PXRMTABS="Y",PXRMTMP'="" D Q
  1. .W !!?PSTART,"The following had no patients selected",!
  1. .N SUB
  1. .S SUB=""
  1. .F S SUB=$O(MISSED(SUB)) Q:SUB="" D
  1. ..W !?PSTART+10,SUB
  1. ;Other reports
  1. N LIT,SUB
  1. D CHECK^PXRMXGPR(5) Q:DONE
  1. S LIT=PXRMFLD
  1. I PXRMSEL="L",$E(PXRMLCSC)="G" S LIT="Clinic Group"
  1. W !!?PSTART,"The following ",LIT,"(s) had no patients selected",!
  1. S SUB=""
  1. F S SUB=$O(MISSED(SUB)) Q:SUB="" D
  1. .D CHECK^PXRMXGPR(3) Q:DONE
  1. .W !?PSTART+10,SUB
  1. Q
  1. ;
  1. ;Build array of locations/providers/teams with no patients
  1. NOPATS(MISSED) ;
  1. N DATA,IC,LTYPE,MARK
  1. S IC=""
  1. I PXRMSEL="P" D Q
  1. . F S IC=$O(PXRMPRV(IC)) Q:IC="" D
  1. .. S DATA=PXRMPRV(IC)
  1. .. D TEST(DATA,$P(DATA,U,1),.MISSED)
  1. I PXRMSEL="T" D
  1. . F S IC=$O(PXRMPCM(IC)) Q:IC="" D
  1. .. S DATA=PXRMPCM(IC)
  1. .. D TEST(DATA,$P(DATA,U,1),.MISSED)
  1. I PXRMSEL="O" D
  1. . F S IC=$O(PXRMOTM(IC)) Q:IC="" D
  1. .. S DATA=PXRMOTM(IC)
  1. .. D TEST(DATA,$P(DATA,U,1),.MISSED)
  1. S LTYPE=$E($G(PXRMLCSC))
  1. I LTYPE="H" D
  1. . F S IC=$O(^XTMP(PXRMXTMP,"HLOC",IC)) Q:IC="" D
  1. .. S DATA=^XTMP(PXRMXTMP,"HLOC",IC)
  1. .. D TEST(DATA,IC,.MISSED)
  1. I LTYPE="C" D
  1. . F S IC=$O(PXRMCS(IC)) Q:IC="" D
  1. .. S DATA=PXRMCS(IC)
  1. .. D TEST(DATA,$P(DATA,U,3),.MISSED)
  1. I LTYPE="G" D
  1. . F S IC=$O(PXRMCGRP(IC)) Q:IC="" D
  1. .. S DATA=PXRMCGRP(IC)
  1. .. D TEST(DATA,$P(DATA,U,1),.MISSED)
  1. Q
  1. ;
  1. ;Check for match on location
  1. TEST(DATA,IEN,MISSED) ;
  1. N SUB
  1. I $D(^XTMP(PXRMXTMP,"MARKED AS FOUND",IEN)) Q
  1. I PXRMSEL'="L" S MISSED($P(DATA,U,2))="" Q
  1. N LTYPE
  1. S LTYPE=$E(PXRMLCSC)
  1. I LTYPE="H" S SUB=IEN D
  1. . N FACNAM,FACNUM,HLOC
  1. . S HLOC=$P(DATA,U,2) Q:HLOC=""
  1. . S FACNUM=$$HFAC^PXRMXSL1(IEN)
  1. . S FACNAM=$S(FACNUM="":"?",1:$P($G(PXRMFACN(FACNUM)),U,1))
  1. . I FACNAM'="" S SUB=HLOC_" ("_FACNAM_")"
  1. I LTYPE="C" S SUB=$P(DATA,U,1)_" "_$P(DATA,U,3)
  1. I LTYPE="G" S SUB=$P(DATA,U,2)
  1. S MISSED(SUB)=""
  1. Q
  1. ;