[623] | 1 | PXRMXSE1 ; SLC/PJH - Build Patient lists for Reminder Due report; 01/25/2006
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
---|
| 3 | ;
|
---|
| 4 | ; Called/jobbed from PXRMXD
|
---|
| 5 | ;
|
---|
| 6 | ; Input - PXRMSEL,PXRMXTMP
|
---|
| 7 | ; PXRM*
|
---|
| 8 | ; Output- ^XTMP(PXRMXTMP
|
---|
| 9 | ;
|
---|
| 10 | ;
|
---|
| 11 | START ;
|
---|
| 12 | N LIT,TOTAL,TODAY,ZTSTOP,BUSY
|
---|
| 13 | S DBDOWN=0
|
---|
| 14 | S TOTAL=0,ZTSTOP="",TODAY=$$DT^XLFDT-.0001
|
---|
| 15 | ;
|
---|
| 16 | K ^TMP($J,"PXRM PATIENT LIST"),^TMP($J,"PXRM PATIENT EVAL")
|
---|
| 17 | K ^TMP($J,"PXRM FUTURE APPT"),^TMP($J,"SDAMA301")
|
---|
| 18 | K ^TMP($J),^TMP(PXRMRT,$J),^TMP("PXRMDUP",$J)
|
---|
| 19 | K ^TMP("PXRMCMB",$J),^TMP("PXRMCMB1",$J),^TMP("PXRMCMB2",$J)
|
---|
| 20 | N PXRMRERR
|
---|
| 21 | ;
|
---|
| 22 | I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
|
---|
| 23 | ;
|
---|
| 24 | ;OE/RR team selected (PXRMOTM)
|
---|
| 25 | I PXRMSEL="O" D OERR^PXRMXSL1
|
---|
| 26 | ;
|
---|
| 27 | ;PCMM team selected (PXRMPCM)
|
---|
| 28 | I PXRMSEL="T" D PCMMT^PXRMXSL1
|
---|
| 29 | ;
|
---|
| 30 | N HLIEN,FACILITY
|
---|
| 31 | ;Location selected (PXRMLCHL,PXRMCGRP)
|
---|
| 32 | I PXRMSEL="L" D G:ZTSTOP=1 EXIT
|
---|
| 33 | .;Build Clinic List
|
---|
| 34 | .D BHLOC^PXRMXSL1
|
---|
| 35 | .;Prior Visits - build patient list in ^TMP
|
---|
| 36 | .I PXRMFD="P" D VISITS^PXRMXSL2 I DBDOWN=1 Q
|
---|
| 37 | .;Inpatient Admissions and current inpatient locations
|
---|
| 38 | .I PXRMFD="A"!(PXRMFD="C") D INPADM^PXRMXSL1
|
---|
| 39 | .;Future Appointments - build patient list in ^TMP
|
---|
| 40 | .I PXRMFD="F" D APPTS^PXRMXSL2 I DBDOWN=1 Q
|
---|
| 41 | .;End task requested
|
---|
| 42 | .Q:ZTSTOP=1
|
---|
| 43 | ;Update ^XTMP from ^TMP
|
---|
| 44 | I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
|
---|
| 45 | ;
|
---|
| 46 | ;PCMM provider selected (PXRMPRV)
|
---|
| 47 | I PXRMSEL="P" D PCMMP^PXRMXSL1
|
---|
| 48 | ;
|
---|
| 49 | ;Individual Patients selected (PXRMPAT)
|
---|
| 50 | I PXRMSEL="I" D IND^PXRMXSL1
|
---|
| 51 | ;
|
---|
| 52 | ;Patient List selected (PXRMLIST)
|
---|
| 53 | I PXRMSEL="R" D LIST^PXRMXSL1
|
---|
| 54 | ;
|
---|
| 55 | I DBDOWN=1 G EXIT
|
---|
| 56 | S START=$H
|
---|
| 57 | D EVAL^PXRMXEVL("PXRM PATIENT EVAL",.REMINDER)
|
---|
| 58 | D XTMP(START)
|
---|
| 59 | ;
|
---|
| 60 | ;Update patient list
|
---|
| 61 | I PXRMSEL'="I"&(PXRMUSER'="Y")&($G(PXRMLIS1)'="") D
|
---|
| 62 | .;If no patients due delete patient list
|
---|
| 63 | .I +$O(^TMP($J,"PXRMXPAT",""))=0 D Q
|
---|
| 64 | ..N DA,DIK S DA=PXRMLIS1,DIK="^PXRMXP(810.5," D ^DIK
|
---|
| 65 | .;Otherwise create patient list
|
---|
| 66 | .D UPDLST^PXRMRULE("PXRMXPAT",PXRMLIS1,"","")
|
---|
| 67 | .S $P(^PXRMXP(810.5,PXRMLIS1,0),U,9)=1
|
---|
| 68 | K ^TMP($J,"PXRMXPAT")
|
---|
| 69 | K ^TMP($J),^TMP(PXRMRT,$J),^TMP("PXRMDUP",$J)
|
---|
| 70 | K ^TMP("PXRMCMB",$J),^TMP("PXRMCMB1",$J),^TMP("PXRMCMB2",$J),^TMP("PXRMCMB3",$J)
|
---|
| 71 | K DBDOWN
|
---|
| 72 | ;
|
---|
| 73 | DONE ;
|
---|
| 74 | ;Sorting is done.
|
---|
| 75 | I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W ! D DONE^PXRMXBSY("done")
|
---|
| 76 | ;
|
---|
| 77 | ;I PXRMDBUG="Y" D DEBUG("End of evaluation:",PXRMREP,"^XTMP(PXRMXTMP,PX)")
|
---|
| 78 | ;Print the report information.
|
---|
| 79 | I PXRMQUE D Q
|
---|
| 80 | .;Start the printing that was queued but not scheduled.
|
---|
| 81 | .N DESC,ROUTINE,TASK
|
---|
| 82 | .S ROUTINE="^PXRMXPR"
|
---|
| 83 | .S DESC="Reminder Due Report - print"
|
---|
| 84 | .S TASK=$G(^XTMP(PXRMXTMP,"PRZTSK"))
|
---|
| 85 | .I TASK="" D NOPRZTSK(PXRMXTMP) Q
|
---|
| 86 | .D REQUE^PXRMXQUE(DESC,ROUTINE,TASK)
|
---|
| 87 | .S ZTREQ="@"
|
---|
| 88 | I 'PXRMQUE D ^PXRMXPR
|
---|
| 89 | Q
|
---|
| 90 | ;
|
---|
| 91 | AWRITE(REF,LS) ;This line tag is a copy of AWRITE^PXRMUTIL
|
---|
| 92 | N CNT,DONE,IC,IND,LEN,PROOT,ROOT,START,TEMP
|
---|
| 93 | I REF="" Q
|
---|
| 94 | S PROOT=$P(REF,")",1)
|
---|
| 95 | S TEMP=$NA(@REF)
|
---|
| 96 | S ROOT=$P(TEMP,")",1)
|
---|
| 97 | S REF=$Q(@REF)
|
---|
| 98 | I REF'[ROOT Q
|
---|
| 99 | S DONE=0,CNT=LS
|
---|
| 100 | F IC=0:0 Q:(REF="")!(DONE) D
|
---|
| 101 | . S START=$F(REF,ROOT)
|
---|
| 102 | . S LEN=$L(REF)
|
---|
| 103 | . S IND=$E(REF,START,LEN)
|
---|
| 104 | . S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=PROOT_IND_"="_@REF
|
---|
| 105 | . S REF=$Q(@REF)
|
---|
| 106 | . I REF'[ROOT S DONE=1
|
---|
| 107 | Q
|
---|
| 108 | ;
|
---|
| 109 | DEBUG(LOC,TYPE,REF) ;
|
---|
| 110 | N CNT,DDAT,FACILITY,HEADER,PNAM,PX,SUB
|
---|
| 111 | K ^TMP("PXRMXMZ",$J)
|
---|
| 112 | S PX="PXRM"
|
---|
| 113 | I TYPE'="P"&(TYPE'="DEBUG") D Q
|
---|
| 114 | .D AWRITE(REF,0)
|
---|
| 115 | .D SEND^PXRMMSG("Debug output: "_LOC_" Reminder Report type "_TYPE_" ("_$$NOW^XLFDT_")",DUZ)
|
---|
| 116 | D AWRITE(REF,0)
|
---|
| 117 | S HEADER=LOC_" ("_$$NOW^XLFDT_")"
|
---|
| 118 | D SEND^PXRMMSG("Debug output: "_HEADER,DUZ)
|
---|
| 119 | Q
|
---|
| 120 | ;
|
---|
| 121 | ERROR(STATUS,ITEM) ;
|
---|
| 122 | ;Create XTMP entry for Reminders that error out or could not be
|
---|
| 123 | ;determing on evaluation
|
---|
| 124 | N ERRNAME
|
---|
| 125 | S STATUS=$P(STATUS,U)
|
---|
| 126 | S ERRNAME=$P(^PXD(811.9,ITEM,0),U)
|
---|
| 127 | I $D(^XTMP(PXRMXTMP,STATUS,ERRNAME))>0,^XTMP(PXRMXTMP,STATUS,ERRNAME)>0 D
|
---|
| 128 | .S ^XTMP(PXRMXTMP,STATUS,ERRNAME)=^XTMP(PXRMXTMP,STATUS,ERRNAME)+1
|
---|
| 129 | E S ^XTMP(PXRMXTMP,STATUS,ERRNAME)=1
|
---|
| 130 | Q
|
---|
| 131 | ;
|
---|
| 132 | ;End Task requested
|
---|
| 133 | EXIT ;
|
---|
| 134 | S ZTSK=$G(^XTMP(PXRMXTMP,"PRZTSK"))
|
---|
| 135 | I ZTSK>0 D KILL^%ZTLOAD
|
---|
| 136 | D EXIT^PXRMXGUT
|
---|
| 137 | K DBDOWN
|
---|
| 138 | Q
|
---|
| 139 | ;
|
---|
| 140 | NOPRZTSK(PXRMXTMP) ;Could not get PRZTSK send an error message
|
---|
| 141 | N TEXT
|
---|
| 142 | K ^TMP("PXRMXMZ",$J)
|
---|
| 143 | S TEXT(1,0)="The task number for the print job cannot be determined."
|
---|
| 144 | S TEXT(2,0)="The reason is:"
|
---|
| 145 | I '$D(^XTMP(PXRMXTMP)) S TEXT(3,0)=" The ^XTMP(PXRMXTMP) global is not defined."
|
---|
| 146 | I $D(^XTMP(PXRMXTMP)),'$D(^XTMP(PXRMXTMP,"PRZTSK")) S TEXT(3,0)=" ^XTMP(PXRMXTMP,""PRZTSK"") does not exist."
|
---|
| 147 | I $D(^XTMP(PXRMXTMP,"PRZTSK")) S TEXT(3,0)=" ^XMTP(PXRMXTMP,""PRZTSK"") is null."
|
---|
| 148 | S TEXT(4,0)="PXRMXTMP="_PXRMXTMP
|
---|
| 149 | M ^TMP("PXRMXMZ",$J)=TEXT
|
---|
| 150 | D SEND^PXRMMSG("REMINDER REPORT ERROR",DUZ)
|
---|
| 151 | Q
|
---|
| 152 | ;
|
---|
| 153 | XTMP(START) ;
|
---|
| 154 | N CNT,CCNT,DDAT,INP,ITEM,LIT,LSSN,MCNBD,MCNBDR,NAME,SUB,STATUS,TEMP,TEMP1
|
---|
| 155 | K ^TMP($J,"PXRM CNBD")
|
---|
| 156 | S CCNT=0,MCNBD=$G(^PXRM(800,1,"MIERR")),MCNBDR=0
|
---|
| 157 | ;I PXRMDBUG="Y" D DEBUG("PATIENT DATA","P","^TMP($J,""PXRM PATIENT EVAL"")")
|
---|
| 158 | S BUSY=0,SUB="NAM",TEMP=0,PX="PXRM"
|
---|
| 159 | N DDAT,DDUE,DEMARR,DFN,DLAST,DNEXT,FACILITY,NAM,PNAM
|
---|
| 160 | S FACILITY="",DDAT="N/A"
|
---|
| 161 | F S FACILITY=$O(^TMP(PXRMRT,$J,FACILITY)) Q:FACILITY="" D
|
---|
| 162 | .S NAM=""
|
---|
| 163 | .F S NAM=$O(^TMP(PXRMRT,$J,FACILITY,NAM)) Q:NAM="" D
|
---|
| 164 | ..S DFN="" F S DFN=$O(^TMP(PXRMRT,$J,FACILITY,NAM,DFN)) Q:DFN="" D
|
---|
| 165 | ...I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D SPIN^PXRMXBSY("Evaluating Reminders",.BUSY)
|
---|
| 166 | ...S INP=$G(^TMP(PXRMRT,$J,FACILITY,NAM,DFN))
|
---|
| 167 | ...S CNT=0 F S CNT=$O(REMINDER(CNT)) Q:CNT'>0 D
|
---|
| 168 | ....S ITEM=$P(REMINDER(CNT),U,1),LIT=$P(REMINDER(CNT),U,4)
|
---|
| 169 | ....I LIT="" S LIT=$P(REMINDER(CNT),U,2)
|
---|
| 170 | ....S STATUS=$G(^TMP($J,"PXRM PATIENT EVAL",DFN,ITEM))
|
---|
| 171 | ....I STATUS="" Q
|
---|
| 172 | ....I STATUS["ERROR"!(STATUS["CNBD") D
|
---|
| 173 | .....D ERROR(STATUS,ITEM) I STATUS["ERROR"!(MCNBDR=1) Q
|
---|
| 174 | .....I CCNT=0 D Q
|
---|
| 175 | ......S ^TMP($J,"PXRM CNBD",1,0)=$$RJ^XLFSTR(" ",5)_$$LJ^XLFSTR("PATIENT NAME",30)_$$RJ^XLFSTR("LAST 4",10)
|
---|
| 176 | ......S (TEMP,TEMP1)=""
|
---|
| 177 | ......F X=1:1:30 S TEMP=TEMP_"_"
|
---|
| 178 | ......F X=1:1:6 S TEMP1=TEMP1_"_"
|
---|
| 179 | ......S ^TMP($J,"PXRM CNBD",2,0)=$$RJ^XLFSTR(" ",5)_$$LJ^XLFSTR(TEMP,30)_$$RJ^XLFSTR(TEMP1,10)
|
---|
| 180 | ......S CCNT=2
|
---|
| 181 | .....S CCNT=CCNT+1
|
---|
| 182 | .....I CCNT>MCNBD S MCNBDR=1 Q
|
---|
| 183 | .....S NAME=$P(^DPT(DFN,0),U)
|
---|
| 184 | .....S LSSN=$E($P(^DPT(DFN,0),U,9),6,9)
|
---|
| 185 | .....S ^TMP($J,"PXRM CNBD",CCNT,0)=$$RJ^XLFSTR(" ",5)_$$LJ^XLFSTR(NAME,30)_$$RJ^XLFSTR(LSSN,10)
|
---|
| 186 | ....;Add reminder status to patient list TMP Global
|
---|
| 187 | ....I STATUS["DUE NOW" S ^TMP($J,"PXRMXPAT",DFN,"REM",ITEM)=ITEM_U_STATUS
|
---|
| 188 | ....I PXRMREP="D" D SDET^PXRMXDT1(DFN,STATUS,NAM,FACILITY,INP)
|
---|
| 189 | ....I PXRMREP="S" D SUM^PXRMXDT1(DFN,STATUS,FACILITY,NAM)
|
---|
| 190 | I $D(^TMP($J,"PXRM CNBD"))>0 D DBDOWN^PXRMXDT1("C")
|
---|
| 191 | K ^TMP($J,"PXRM CNBD")
|
---|
| 192 | S END=$H
|
---|
| 193 | I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DETIME^PXRMXSL1(START,END,"Evaluating Reminders")
|
---|
| 194 | ;I PXRMDBUG="Y" D DEBUG("DEBUG PATIENT DATA EVALUATION","DEBUG","^TMP($J,""PXRMDEBUG"")")
|
---|
| 195 | K ^TMP($J,"PXRM PATIENT EVAL")
|
---|
| 196 | Q
|
---|
| 197 | ;
|
---|