Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXSE1.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/PXRMXSE1.m
r613 r623 1 PXRMXSE1 ; SLC/PJH - Build Patient lists for Reminder Due report; 08/16/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 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,"","","",PXRMDPAT,PXRMTPAT) 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 155 N SUB,STATUS,TEMP,TEMP1,TEXT 156 K ^TMP($J,"PXRM CNBD") 157 S CCNT=0,MCNBD=$G(^PXRM(800,1,"MIERR")),MCNBDR=0 158 ;I PXRMDBUG="Y" D DEBUG("PATIENT DATA","P","^TMP($J,""PXRM PATIENT EVAL"")") 159 S BUSY=0,SUB="NAM",TEMP=0,PX="PXRM" 160 N DDAT,DDUE,DEMARR,DFN,DLAST,DNEXT,FACILITY,NAM,PNAM 161 S FACILITY="",DDAT="N/A" 162 F S FACILITY=$O(^TMP(PXRMRT,$J,FACILITY)) Q:FACILITY="" D 163 .S NAM="" 164 .F S NAM=$O(^TMP(PXRMRT,$J,FACILITY,NAM)) Q:NAM="" D 165 ..S DFN="" F S DFN=$O(^TMP(PXRMRT,$J,FACILITY,NAM,DFN)) Q:DFN="" D 166 ...I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D SPIN^PXRMXBSY("Evaluating Reminders",.BUSY) 167 ...S INP=$G(^TMP(PXRMRT,$J,FACILITY,NAM,DFN)) 168 ...S CNT=0 F S CNT=$O(REMINDER(CNT)) Q:CNT'>0 D 169 ....S ITEM=$P(REMINDER(CNT),U,1),LIT=$P(REMINDER(CNT),U,4) 170 ....I LIT="" S LIT=$P(REMINDER(CNT),U,2) 171 ....S STATUS=$G(^TMP($J,"PXRM PATIENT EVAL",DFN,ITEM)) 172 ....I STATUS="" Q 173 ....I STATUS["ERROR"!(STATUS["CNBD") D 174 .....D ERROR(STATUS,ITEM) I STATUS["ERROR"!(MCNBDR=1) Q 175 .....I CCNT=0 D Q 176 ......S ^TMP($J,"PXRM CNBD",1,0)=$$RJ^XLFSTR(" ",5)_$$LJ^XLFSTR("PATIENT NAME",30)_$$RJ^XLFSTR("LAST 4",10) 177 ......S (TEMP,TEMP1)="" 178 ......F X=1:1:30 S TEMP=TEMP_"_" 179 ......F X=1:1:6 S TEMP1=TEMP1_"_" 180 ......S ^TMP($J,"PXRM CNBD",2,0)=$$RJ^XLFSTR(" ",5)_$$LJ^XLFSTR(TEMP,30)_$$RJ^XLFSTR(TEMP1,10) 181 ......S CCNT=2 182 .....S CCNT=CCNT+1 183 .....I CCNT>MCNBD S MCNBDR=1 Q 184 .....S NAME=$P(^DPT(DFN,0),U) 185 .....S LSSN=$E($P(^DPT(DFN,0),U,9),6,9) 186 .....S ^TMP($J,"PXRM CNBD",CCNT,0)=$$RJ^XLFSTR(" ",5)_$$LJ^XLFSTR(NAME,30)_$$RJ^XLFSTR(LSSN,10) 187 ....;Add reminder status to patient list TMP Global 188 ....I STATUS["DUE NOW" S ^TMP($J,"PXRMXPAT",DFN,"REM",ITEM)=ITEM_U_STATUS 189 ....I PXRMREP="D" D SDET^PXRMXDT1(DFN,STATUS,NAM,FACILITY,INP) 190 ....I PXRMREP="S" D SUM^PXRMXDT1(DFN,STATUS,FACILITY,NAM) 191 I $D(^TMP($J,"PXRM CNBD"))>0 D ERRMSG^PXRMXDT1("C") 192 K ^TMP($J,"PXRM CNBD") 193 S END=$H 194 S TEXT="Elapsed time for reminder evaluation: "_$$DETIME^PXRMXSL1(START,END) 195 S ^XTMP(PXRMXTMP,"TIMING","REMINDER EVALUATION")=TEXT 196 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT 197 ;I PXRMDBUG="Y" D DEBUG("DEBUG PATIENT DATA EVALUATION","DEBUG","^TMP($J,""PXRMDEBUG"")") 198 K ^TMP($J,"PXRM PATIENT EVAL") 199 Q 200 ; 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 ;
Note:
See TracChangeset
for help on using the changeset viewer.
