source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXPR1.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1PXRMXPR1 ; SLC/AGP - Print Reminder Due report carryover code. ;01/05/2006
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;Patient list display
5FOOTER(PLSTCRIT) ;
6 N CNT,CNT1,COUNT,TEXT
7 ;Count patients in list
8 S COUNT=+$O(^PXRMXP(810.5,PXRMLIS1,30,"A"),-1)
9 ;
10 I COUNT=0 W !!!,"No patients due. Patient List not created" Q
11 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)
12 W !!,"List contains "_COUNT_" patients, report run on "_TTOTAL_" patients."
13 ;
14 ;Screen out formatting lines and second piece of criteria array
15 S (CNT,CNT1)=0 F S CNT=$O(PLSTCRIT(CNT)) Q:CNT'>0 D
16 .I $P($G(PLSTCRIT(CNT)),U)="",$P($G(PLSTCRIT(CNT)),U,2)>0 Q
17 .S CNT1=CNT1+1 S TEXT(CNT1)=$P($G(PLSTCRIT(CNT)),U)
18 ;Store Report Criteria in the document multiple of the patient list
19 F CNT1=1:1:CNT1 S ^PXRMXP(810.5,PXRMLIS1,200,CNT1,0)=TEXT(CNT1)
20 S ^PXRMXP(810.5,PXRMLIS1,200,0)=U_"810.51"_U_CNT1_U_CNT1
21 Q
22 ;
23 ;Set up literals for display
24LITS ;
25 I PXRMSEL="I" S PXRMFLD="Individual Patients"
26 I PXRMSEL="R" S PXRMFLD="Patient List"
27 I PXRMSEL="P" S PXRMFLD="PCMM Provider"
28 I PXRMSEL="O" S PXRMFLD="OE/RR Team"
29 I PXRMSEL="T" S PXRMFLD="PCMM Team"
30 I PXRMSEL="L" D
31 .S PXRMFLD="Location"
32 .I $P(PXRMLCSC,U)="HS" S DES="Selected Hospital Locations"
33 .I $P(PXRMLCSC,U)="HA" S DES="All Outpatient Locations"
34 .I $P(PXRMLCSC,U)="HAI" S DES="All Inpatient Locations"
35 .I $P(PXRMLCSC,U)="CS" S DES="Selected Clinic Stops"
36 .I $P(PXRMLCSC,U)="CA" S DES="All Clinic Stops"
37 .I $P(PXRMLCSC,U)="GS" S DES="Selected Clinic Groups"
38 .I PXRMFD="P" S DES=DES_" (Prior Encounters)"
39 .I PXRMFD="F" S DES=DES_" (Future Appoints.)"
40 .I PXRMFD="A" S DES=DES_" (Admissions)"
41 .I PXRMFD="C" S DES=DES_" (Current Inpatients)"
42 I PXRMSEL="P" D
43 .I PXRMPRIM="A" S CDES="All patients on list"
44 .I PXRMPRIM="P" S CDES="Primary care assigned patients only"
45 Q
46 ;
47 ;Report missed locations if report is partially successful
48MISSED(PSTART,MISSED) ;
49 ;Delimited report from template
50 I PXRMTABS="Y",PXRMTMP'="" D Q
51 .W !!?PSTART,"The following had no patients selected",!
52 .N SUB
53 .S SUB=""
54 .F S SUB=$O(MISSED(SUB)) Q:SUB="" D
55 ..W !?PSTART+10,SUB
56 ;Other reports
57 N LIT,SUB
58 D CHECK^PXRMXGPR(5) Q:DONE
59 S LIT=PXRMFLD
60 I PXRMSEL="L",$E(PXRMLCSC)="G" S LIT="Clinic Group"
61 W !!?PSTART,"The following ",LIT,"(s) had no patients selected",!
62 S SUB=""
63 F S SUB=$O(MISSED(SUB)) Q:SUB="" D
64 .D CHECK^PXRMXGPR(3) Q:DONE
65 .W !?PSTART+10,SUB
66 Q
67 ;
68 ;Build array of locations/providers/teams with no patients
69NOPATS(MISSED) ;
70 N DATA,IC,LTYPE,MARK
71 S IC=""
72 I PXRMSEL="P" D Q
73 . F S IC=$O(PXRMPRV(IC)) Q:IC="" D
74 .. S DATA=PXRMPRV(IC)
75 .. D TEST(DATA,$P(DATA,U,1),.MISSED)
76 I PXRMSEL="T" D
77 . F S IC=$O(PXRMPCM(IC)) Q:IC="" D
78 .. S DATA=PXRMPCM(IC)
79 .. D TEST(DATA,$P(DATA,U,1),.MISSED)
80 I PXRMSEL="O" D
81 . F S IC=$O(PXRMOTM(IC)) Q:IC="" D
82 .. S DATA=PXRMOTM(IC)
83 .. D TEST(DATA,$P(DATA,U,1),.MISSED)
84 S LTYPE=$E($G(PXRMLCSC))
85 I LTYPE="H" D
86 . F S IC=$O(^XTMP(PXRMXTMP,"HLOC",IC)) Q:IC="" D
87 .. S DATA=^XTMP(PXRMXTMP,"HLOC",IC)
88 .. D TEST(DATA,IC,.MISSED)
89 I LTYPE="C" D
90 . F S IC=$O(PXRMCS(IC)) Q:IC="" D
91 .. S DATA=PXRMCS(IC)
92 .. D TEST(DATA,$P(DATA,U,3),.MISSED)
93 I LTYPE="G" D
94 . F S IC=$O(PXRMCGRP(IC)) Q:IC="" D
95 .. S DATA=PXRMCGRP(IC)
96 .. D TEST(DATA,$P(DATA,U,1),.MISSED)
97 Q
98 ;
99 ;Check for match on location
100TEST(DATA,IEN,MISSED) ;
101 N SUB
102 I $D(^XTMP(PXRMXTMP,"MARKED AS FOUND",IEN)) Q
103 I PXRMSEL'="L" S MISSED($P(DATA,U,2))="" Q
104 N LTYPE
105 S LTYPE=$E(PXRMLCSC)
106 I LTYPE="H" S SUB=IEN D
107 . N FACNAM,FACNUM,HLOC
108 . S HLOC=$P(DATA,U,2) Q:HLOC=""
109 . S FACNUM=$$HFAC^PXRMXSL1(IEN)
110 . S FACNAM=$S(FACNUM="":"?",1:$P($G(PXRMFACN(FACNUM)),U,1))
111 . I FACNAM'="" S SUB=HLOC_" ("_FACNAM_")"
112 I LTYPE="C" S SUB=$P(DATA,U,1)_" "_$P(DATA,U,3)
113 I LTYPE="G" S SUB=$P(DATA,U,2)
114 S MISSED(SUB)=""
115 Q
116 ;
Note: See TracBrowser for help on using the repository browser.