Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXPR1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXPR1.m
r613 r623 1 PXRMXPR1 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 4 5 FOOTER(PLSTCRIT) 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 LITS 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 MISSED(PSTART,MISSED) 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 NOPATS(MISSED) 70 71 72 I PXRMSEL="P" D Q 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 TEST(DATA,IEN,MISSED) 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 1 PXRMXPR1 ; SLC/AGP - Print Reminder Due report carryover code. ;01/05/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;Patient list display 5 FOOTER(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 24 LITS ; 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 48 MISSED(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 69 NOPATS(MISSED) ; 70 N DATA,IC,LTYPE,MARK 71 S IC="" 72 I PXRMSEL="P" D 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 100 TEST(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 TracChangeset
for help on using the changeset viewer.
