GMRCYP70 ;BP/SBR - CONSULT NOTE STORED ON WRONG PATIENT ; 11/07/2008
;;3.0;CONSULT/REQUEST TRACKING;**70**;;Build 17
;
ENV ;
S XPDNOQUE=1 ;don't allow install to be queued
Q
;
EN1 ;
I $G(DUZ)="" D BMES^XPDUTL("Your DUZ is not defined.")
N GMRCRECP,ZTDESC,ZTIO,ZTRTN,ZTSK,ZTSAVE,ZTQUEUED,ZTREQ,ZTDTH
S GMRCRECP($S(+DUZ:DUZ,1:.5))=""
D NAMELIST("Choose message recipients: ",.GMRCRECP,"")
TASK S ZTRTN="START^GMRCYP70",ZTIO=""
S ZTSAVE("GMRCRECP(")=""
S ZTDESC="Search for Results on Wrong Consult Patient",ZTDTH=$H
D ^%ZTLOAD
D BMES^XPDUTL("The search for results on wrong consult patient is"_$S($D(ZTSK):"",1:" NOT")_" queued")
I $D(ZTSK) D MES^XPDUTL(" (to start NOW)."),BMES^XPDUTL("YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED.")
Q
;
START ;
S:$D(ZTQUEUED) ZTREQ="@"
N GMRCTTL,XCNT
K ^TMP("GMRCYP70",$J)
D SEARCH
I GMRCTTL D MSG
I GMRCTTL=0 D NOMSG
Q
SEARCH ;Search for results attached to the wrong patient.
;DBIA #5350 Clinical Procedures to get the Medical Patient IEN.
;DBIA #2693 TIU to get the Patient IEN.
;DBIA #2467 Consults to get the ORDERABLE ITEM from the ORDER file.
;
N GMRCLOC,GMRCDIV,GMRC0,GMRCCNST,GMRCSEQ,GMRCRSLT,GMRCPAT,GMRCRSPT
N GMRCDT,GMRCRSDT,GMRCDTX,GMRCCPT,GMRCNAME,GMRCERR,GMRCOERR,GMRCTYP,X
S (GMRC0,GMRCCNST,GMRCRSLT,GMRCDT,GMRCRSDT,GMRCDTX,GMRCCPT,GMRCNAME,GMRCOERR,GMRCTYPE,X)=""
S (XCNT,GMRCRSPT,GMRCTTL)=0
S GMRCCNST=0 F S GMRCCNST=$O(^GMR(123,GMRCCNST)) Q:GMRCCNST="" Q:GMRCCNST'>0 D
. S GMRC0=$G(^GMR(123,GMRCCNST,0)),XCNT=XCNT+1,(GMRCLOC,GMRCDIV)=""
. F S GMRCRSLT=$O(^GMR(123,GMRCCNST,50,"B",GMRCRSLT)) Q:GMRCRSLT="" D
.. S GMRCNAME="",GMRCERR=""
.. S GMRCCPT=$P(GMRC0,U,2),(GMRCDT,GMRCDTX)=$P(GMRC0,U,1)
.. S GMRCTYPE=$P($P(GMRCRSLT,"(",2),",",1)
.. I $P(GMRCRSLT,";",2)="TIU(8925," D I +GMRCERR Q
... N GMRCTIU
... D EXTRACT^TIULQ(+GMRCRSLT,"GMRCTIU",.GMRCERR,".02;1201",,,"IE")
... I +GMRCERR Q
... S GMRCRSPT=$G(GMRCTIU(+GMRCRSLT,.02,"I"))
... S GMRCRSDT=$G(GMRCTIU(+GMRCRSLT,1201,"E"))
... ;I GMRCCPT=GMRCRSPT K GMRCTIU(+GMRCRSLT)
.. I $P(GMRCRSLT,";",2)'="TIU(8925," D
... S X=$P($P($P(GMRCRSLT,";",2),",",1),"(",2)
... I X'=699,X'=699.5 S GMRCRSPT=$$GET1^DIQ(X,+GMRCRSLT,1,"I")
... I X=699!(X=699.5) S GMRCRSPT=$$GET1^DIQ(X,+GMRCRSLT,.02,"I")
... I $G(GMRCRSPT)'="" S GMRCRSPT=$$GET1^DIQ(690,GMRCRSPT,.01,"I")
... I X=698!(X=698.1)!(X=698.2)!(X=698.3)!(X=701) S GMRCRSDT=$$GET1^DIQ(X,+GMRCRSLT,.01,"E")
... I X'=698,X'=698.1,X'=698.2,X'=698.3,X'=701 D
.... S GMRCRSDT=$$GET1^DIQ(X,+GMRCRSLT,1502,"E")
.... I GMRCRSDT="" S GMRCRSDT=$$GET1^DIQ(X,+GMRCRSLT,.01,"E")
.. I GMRCCPT=GMRCRSPT Q ;stored correctly
.. ;For this report, we will quit if any patient iens are not found
.. I GMRCRSPT="" Q ;S GMRCRSPT="<NO IEN FOUND>"
.. I GMRCCPT="" Q ;S GMRCCPT="<NO IEN FOUND>"
.. ;
.. S GMRCOERR=$P(GMRC0,U,3)
.. I GMRCOERR'="" S GMRCNAME=$P($$OI^ORX8(GMRCOERR),U,2)
.. I GMRCNAME="",+$P(GMRC0,U,8) D
... N GMRCPTR,GMRCFL,GMRCPRC
... S GMRCPRC=$P(GMRC0,U,8),GMRCPTR=+GMRCPRC,GMRCFL=$P(GMRCPRC,";",2)
... I +GMRCPTR,GMRCFL'="" S GMRCPRC="^"_GMRCFL_GMRCPTR_",0)" D
.... S GMRCNAME=$P($G(@GMRCPRC),U,1)
.. I GMRCNAME="" S GMRCNAME=$P($G(^GMR(123.5,$P(GMRC0,U,5),0)),U,1)
.. S GMRCLOC=+$P(GMRC0,U,4)
.. S GMRCDIV=+$P($G(^SC(GMRCLOC,0)),U,4)
.. S GMRCTTL=GMRCTTL+1
.. I GMRCDT="" S GMRCDTX="NO DATE "_GMRCTTL
.. S ^TMP("GMRCYP70",$J,GMRCDIV,GMRCCNST,GMRCDTX,GMRCTTL)=GMRCCNST_U_GMRCNAME_U_GMRCDT_U_GMRCCPT_U_GMRCRSPT_U_GMRCTYPE_U_+GMRCRSLT_U_GMRCRSDT_U_XCNT
Q
;
MSG ;Send Mailman message to installer
N GMRC0,GMRCIEN,GMRCC,GMRCCNT,GMRCTPT,GMRCDT,GMRCFDT,GMRCRDT,GMRCNAME
N GMRCPFLG,GMRCCPT,GMRCTYPE,GMRCDOC,GMRCCON,GMRCX,GMRCMSG,GMRCPARM
N GMRCPG,GMRCSPC,GMRCTPG,GMRCTXT,GMRCDIV,GMRCEDIV,GMRCSIEN,GMRCRTTL
N XMDUZ,XMERR,XMSUB,XMTEXT,XMY,Y
S (GMRCCON,GMRCNAME,GMRCCPT,GMRCTPT,GMRCDOC,GMRCTYPE)=""
I $D(GMRCRECP) M XMY=GMRCRECP
I DUZ="" N DUZ S DUZ=.5
S XMDUZ=DUZ,XMTEXT="GMRCTXT"
S XMY(DUZ)=""
D
. S GMRCPG=0,GMRCDIV="",GMRCSIEN=""
. D TOTAL
. S GMRCTPG=GMRCRTTL/500 I GMRCTPG#1 S GMRCTPG=$P(GMRCTPG,".")+1
. F GMRCPG=1:1:GMRCTPG D
.. K GMRCTXT
.. S GMRCC=0
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message ("_GMRCPG_" of "_GMRCTPG_") has been sent by routine GMRCYP70 at the completion"
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="of the Consult Result evaluation."
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
.. S XMSUB="CONSULT NOTE ON WRONG PATIENT (MSG "_GMRCPG_" of "_GMRCTPG_")"
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="In the report below, the patient IEN from the ASSOCIATED RESULTS file (8925,"
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="691, 691.1, etc.) does not match the patient IEN stored on the consult"
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="in the REQUEST/CONSULTATION file."
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="A team including a Clinical Application Coordinator, Chief, Health"
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Information Management, and other pertinent facility staff should"
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="review the results of the report generated by this patch. This step is"
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="critical to ensuring the integrity and accuracy of the Consult data at"
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="your facility."
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="See the description for patch GMRC*3.0*70 in the National Patch Module"
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="for further explanation of this report and for instructions on how to"
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="correct the listed entries."
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" CONSULT # CONSULT NAME CONSULT DATE/TIME "
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" CONSULT PT IEN # RESULT PT IEN # RESULT TYPE RESULT DOC # "
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" RESULT DATE/TIME "
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="============================================================================="
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
.. S GMRCSPC=" "
.. S GMRCCNT=0,GMRCPFLG=0
.. I +$G(GMRCSIEN) S GMRCDIV=GMRCDIV-1
.. F S GMRCDIV=$O(^TMP("GMRCYP70",$J,GMRCDIV)) Q:GMRCDIV="" D Q:GMRCCNT>497
... I GMRCCNT'=0 D
.... N I
.... F I=1:1:3 S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
... S GMRCEDIV=$$EXTERNAL^DILFD(44,3,"",GMRCDIV)
... I GMRCEDIV']"" S GMRCEDIV="UNKNOWN"
... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="-----------------------------------------------------------------------------"
... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Division: "_GMRCEDIV
... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="-----------------------------------------------------------------------------"
... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
... I '+$G(GMRCSIEN) S GMRCIEN=""
... I +$G(GMRCSIEN) S GMRCSIEN=""
... F S GMRCIEN=$O(^TMP("GMRCYP70",$J,GMRCDIV,GMRCIEN)) Q:GMRCIEN="" D Q:+GMRCPFLG
.... S GMRCDT=""
.... F S GMRCDT=$O(^TMP("GMRCYP70",$J,GMRCDIV,GMRCIEN,GMRCDT)) Q:GMRCDT="" D
..... S GMRCX=""
..... F S GMRCX=$O(^TMP("GMRCYP70",$J,GMRCDIV,GMRCIEN,GMRCDT,GMRCX)) Q:GMRCX="" D
...... S GMRC0=$G(^TMP("GMRCYP70",$J,GMRCDIV,GMRCIEN,GMRCDT,GMRCX))
...... S Y=$P(GMRC0,"^",3) ;SET DATE
...... D DD^%DT
...... I Y=-1 S Y="DATE ERROR"
...... S GMRCFDT=Y
...... S GMRCCON=$E(GMRCIEN_GMRCSPC,1,15)
...... S GMRCFDT=$E(GMRCFDT_GMRCSPC,1,18)
...... S GMRCNAME=$E($P(GMRC0,U,2)_GMRCSPC,1,23)_" "
...... S GMRCCPT=$E($P(GMRC0,U,4)_GMRCSPC,1,21)
...... S GMRCTPT=$E($P(GMRC0,U,5)_GMRCSPC,1,19)
...... S GMRCTYPE=$E($P(GMRC0,U,6)_GMRCSPC,1,16)
...... S GMRCDOC=$E($P(GMRC0,U,7)_GMRCSPC,1,20)
...... S GMRCRDT=$E($P(GMRC0,U,8)_GMRCSPC,1,21)
...... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCCON_GMRCNAME_GMRCFDT
...... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCCPT_GMRCTPT_GMRCTYPE_GMRCDOC
...... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "_GMRCRDT
...... S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
...... S GMRCCNT=GMRCCNT+1
.... I GMRCCNT>499 D
..... I +$O(^TMP("GMRCYP70",$J,GMRCDIV,GMRCIEN)) S GMRCSIEN=GMRCIEN
..... S GMRCPFLG=1
.. I GMRCCNT=0 Q
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Total records searched: "_XCNT
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Total records in this message: "_GMRCCNT
.. S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Total records attached to wrong patient: "_GMRCTTL
.. D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.GMRCPARM,"","")
.. S GMRCMSG(1)=" "
.. S GMRCMSG(2)="******************************************************************************"
.. D
... S GMRCMSG(3)="** Message ("_$S($L(GMRCPG)=1:$J("0"_GMRCPG,2),1:GMRCPG)_" of "_$S($L(GMRCTPG)=1:$J("0"_GMRCTPG,2),1:GMRCTPG)_") containing Consult records which have a consult result**"
... I '$D(XMERR) S GMRCMSG(4)="** attached to the wrong patient. **"
... I $D(XMERR) D
.... S GMRCMSG(4)="** attached to the wrong patient was NOT sent. **"
.... S GMRCMSG(5)="** The message was not sent due to an error in the message setup. **"
.... S GMRCMSG(6)="** Dumping message to screen. **"
.... S GMRCMSG(7)="******************************************************************************"
.. I '$D(XMERR) S GMRCMSG(5)="******************************************************************************"
. K ^TMP("GMRCYP70",$J)
Q
;
NOMSG ;Send Mailman message to installer - no records found
N GMRCC,GMRCMSG,GMRCPARM,GMRCSPC,GMRCTXT
N XMDUZ,XMERR,XMSUB,XMTEXT,XMY,Y
I DUZ="" N DUZ S DUZ=.5
S XMDUZ=DUZ,XMTEXT="GMRCTXT"
S XMY(DUZ)=""
K GMRCTXT
S GMRCC=0
S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="This message has been sent by routine GMRCYP70 at the completion"
S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="of the Consult Result evaluation."
S GMRCC=GMRCC+1,GMRCTXT(GMRCC)=" "
S XMSUB="NO MATCHES FOUND - CONSULT RESULTS"
S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="All Consult Results are attached to the correct patient."
S GMRCSPC=" "
S GMRCC=GMRCC+1,GMRCTXT(GMRCC)="Total records attached to wrong patient: "_$G(GMRCTTL)
D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.GMRCPARM,"","")
S GMRCMSG(1)=" "
S GMRCMSG(2)="******************************************************************************"
S GMRCMSG(3)="** Message containing Consult records which have a Consult Result **"
I '$D(XMERR) S GMRCMSG(4)="** attached to the wrong Patient was sent. **"
I $D(XMERR) D
. S GMRCMSG(4)="** attached to the wrong patient was NOT sent. **"
. S GMRCMSG(5)="** The message was not sent due to an error in the message setup. **"
. S GMRCMSG(6)="** Dumping message to screen. **"
. S GMRCMSG(7)="******************************************************************************"
I '$D(XMERR) S GMRCMSG(5)="******************************************************************************"
Q
;
TOTAL ;Calculate adjusted result totals to determine total messages needed
N GMRCDIV,GMRCDT,GMRCIEN,GMRCTCNT,GMRCX
S GMRCRTTL=0
S GMRCDIV=""
TOTAL1 S (GMRCTCNT,GMRCPFLG)=0
D
. I +$G(GMRCSIEN) S GMRCDIV=GMRCDIV-1
. F S GMRCDIV=$O(^TMP("GMRCYP70",$J,GMRCDIV)) Q:GMRCDIV="" D Q:GMRCTCNT>497
.. I '+$G(GMRCSIEN) S GMRCIEN=""
.. I +$G(GMRCSIEN) S GMRCSIEN=""
.. F S GMRCIEN=$O(^TMP("GMRCYP70",$J,GMRCDIV,GMRCIEN)) Q:GMRCIEN="" D Q:+GMRCPFLG
... S GMRCDT=""
... F S GMRCDT=$O(^TMP("GMRCYP70",$J,GMRCDIV,GMRCIEN,GMRCDT)) Q:GMRCDT="" D
.... S GMRCX=""
.... F S GMRCX=$O(^TMP("GMRCYP70",$J,GMRCDIV,GMRCIEN,GMRCDT,GMRCX)) Q:GMRCX="" D
..... S GMRCTCNT=GMRCTCNT+1
... I GMRCTCNT>499 D
.... I +$O(^TMP("GMRCYP70",$J,GMRCDIV,GMRCIEN)) S GMRCSIEN=GMRCIEN
.... S GMRCPFLG=1
.... S GMRCRTTL=GMRCRTTL+1
. I GMRCTCNT<500 S GMRCRTTL=GMRCRTTL+GMRCTCNT
G:GMRCDIV'="" TOTAL1
Q
;
NAMELIST(GMRCP,GMRCOLD,GMRCDELR) ;manage the list of recipients
;
; GMRCP - Prompt
; GMRCOLD - Original list with ordering provider.
; GMRCDELR - 1 means the original list may have names deleted
; Returns final list in GMRCOLD array
;
N GMRCNEW,GMRCNT,GMRCDUZ,GMRCUSER,GMRCQ,GMRCADD,DIC,X,Y
M GMRCNEW=GMRCOLD
I GMRCDELR=1 K GMRCOLD S GMRCOLD="" ;Remove mandatory users from GMRCOLD
S GMRCNT=0 F D Q:(GMRCUSER[U)
. S GMRCUSER=$$READ("FAO;3;46",GMRCP,"","^D NAMEHELP^GMRCYP70")
. S:'$L(GMRCUSER) GMRCUSER=U Q:(GMRCUSER[U)
. I ($E(GMRCUSER,1)="-") S GMRCADD=0,GMRCUSER=$E(GMRCUSER,2,$L(GMRCUSER))
. E S GMRCADD=1
. S X=GMRCUSER,DIC=200,DIC(0)="EMQ" D ^DIC
. I (Y>0) D I 1
.. I GMRCADD D
... I $D(GMRCNEW(+Y)) D MES^XPDUTL(" already in the list.") Q
... S GMRCNEW(+Y)="" D MES^XPDUTL(" added to the list.") S GMRCNT=GMRCNT+1
.. I 'GMRCADD D
... I $D(GMRCOLD(+Y)) D MES^XPDUTL(" can't delete this name from the list.") Q
... I '$D(GMRCNEW(+Y)) D MES^XPDUTL(" not currently in the list.") Q
... K GMRCNEW(+Y) S GMRCNT=GMRCNT-1 D MES^XPDUTL(" deleted from the list.")
. E I $L(GMRCUSER) D MES^XPDUTL(" Name not found.")
. D MES^XPDUTL(" ")
M GMRCOLD=GMRCNEW
Q
;
READ(GMRC0,GMRCA,GMRCB,GMRCH,GMRCL) ;read logic
;
; GMRC0 -> DIR(0) --- Type of read
; GMRCA -> DIR("A") - Prompt
; GMRCB -> DIR("B") - Default Answer
; GMRCH -> DIR("?") - Help text or ^Execute code
; GMRCL -> Number of blank lines to put before Prompt
;
; Returns "^" or answer
;
N GMRCLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
Q:'$L($G(GMRC0)) U
S DIR(0)=GMRC0
S:$L($G(GMRCA)) DIR("A")=GMRCA
S:$L($G(GMRCB)) DIR("B")=GMRCB
S:$L($G(GMRCH)) DIR("?")=GMRCH
F GMRCLINE=1:1:($G(GMRCL)-1) W !
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
Q Y
;
;
NAMEHELP ;Help for the recipient list logic
N GMRCDUZ
D BMES^XPDUTL("Enter the name of the user to send the message to,")
D MES^XPDUTL(" or put a '-' in front of a name to delete from the list.")
D MES^XPDUTL(" ")
D MES^XPDUTL(" Example:")
D BMES^XPDUTL(" SMITH,FRED -> to add Fred to the list.")
D MES^XPDUTL(" -SMITH,FRED -> to delete Fred from the list.")
D BMES^XPDUTL("Already selected: ")
D MES^XPDUTL(" ")
S GMRCDUZ=0 F S GMRCDUZ=$O(GMRCNEW(GMRCDUZ)) Q:'GMRCDUZ D
. I '$D(GMRCOLD(GMRCDUZ)) D MES^XPDUTL(" "_$P(^VA(200,GMRCDUZ,0),U,1))
. I $D(GMRCOLD(GMRCDUZ)) D MES^XPDUTL(" "_$P(^VA(200,GMRCDUZ,0),U,1)_" <mandatory>")
D MES^XPDUTL(" ")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCYP70 14733 printed Apr 09, 2024@20:52:29 Page 2
GMRCYP70 ;BP/SBR - CONSULT NOTE STORED ON WRONG PATIENT ; 11/07/2008
+1 ;;3.0;CONSULT/REQUEST TRACKING;**70**;;Build 17
+2 ;
ENV ;
+1 ;don't allow install to be queued
SET XPDNOQUE=1
+2 QUIT
+3 ;
EN1 ;
+1 IF $GET(DUZ)=""
DO BMES^XPDUTL("Your DUZ is not defined.")
+2 NEW GMRCRECP,ZTDESC,ZTIO,ZTRTN,ZTSK,ZTSAVE,ZTQUEUED,ZTREQ,ZTDTH
+3 SET GMRCRECP($SELECT(+DUZ:DUZ,1:.5))=""
+4 DO NAMELIST("Choose message recipients: ",.GMRCRECP,"")
TASK SET ZTRTN="START^GMRCYP70"
SET ZTIO=""
+1 SET ZTSAVE("GMRCRECP(")=""
+2 SET ZTDESC="Search for Results on Wrong Consult Patient"
SET ZTDTH=$HOROLOG
+3 DO ^%ZTLOAD
+4 DO BMES^XPDUTL("The search for results on wrong consult patient is"_$SELECT($DATA(ZTSK):"",1:" NOT")_" queued")
+5 IF $DATA(ZTSK)
DO MES^XPDUTL(" (to start NOW).")
DO BMES^XPDUTL("YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED.")
+6 QUIT
+7 ;
START ;
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 NEW GMRCTTL,XCNT
+3 KILL ^TMP("GMRCYP70",$JOB)
+4 DO SEARCH
+5 IF GMRCTTL
DO MSG
+6 IF GMRCTTL=0
DO NOMSG
+7 QUIT
SEARCH ;Search for results attached to the wrong patient.
+1 ;DBIA #5350 Clinical Procedures to get the Medical Patient IEN.
+2 ;DBIA #2693 TIU to get the Patient IEN.
+3 ;DBIA #2467 Consults to get the ORDERABLE ITEM from the ORDER file.
+4 ;
+5 NEW GMRCLOC,GMRCDIV,GMRC0,GMRCCNST,GMRCSEQ,GMRCRSLT,GMRCPAT,GMRCRSPT
+6 NEW GMRCDT,GMRCRSDT,GMRCDTX,GMRCCPT,GMRCNAME,GMRCERR,GMRCOERR,GMRCTYP,X
+7 SET (GMRC0,GMRCCNST,GMRCRSLT,GMRCDT,GMRCRSDT,GMRCDTX,GMRCCPT,GMRCNAME,GMRCOERR,GMRCTYPE,X)=""
+8 SET (XCNT,GMRCRSPT,GMRCTTL)=0
+9 SET GMRCCNST=0
FOR
SET GMRCCNST=$ORDER(^GMR(123,GMRCCNST))
if GMRCCNST=""
QUIT
if GMRCCNST'>0
QUIT
Begin DoDot:1
+10 SET GMRC0=$GET(^GMR(123,GMRCCNST,0))
SET XCNT=XCNT+1
SET (GMRCLOC,GMRCDIV)=""
+11 FOR
SET GMRCRSLT=$ORDER(^GMR(123,GMRCCNST,50,"B",GMRCRSLT))
if GMRCRSLT=""
QUIT
Begin DoDot:2
+12 SET GMRCNAME=""
SET GMRCERR=""
+13 SET GMRCCPT=$PIECE(GMRC0,U,2)
SET (GMRCDT,GMRCDTX)=$PIECE(GMRC0,U,1)
+14 SET GMRCTYPE=$PIECE($PIECE(GMRCRSLT,"(",2),",",1)
+15 IF $PIECE(GMRCRSLT,";",2)="TIU(8925,"
Begin DoDot:3
+16 NEW GMRCTIU
+17 DO EXTRACT^TIULQ(+GMRCRSLT,"GMRCTIU",.GMRCERR,".02;1201",,,"IE")
+18 IF +GMRCERR
QUIT
+19 SET GMRCRSPT=$GET(GMRCTIU(+GMRCRSLT,.02,"I"))
+20 SET GMRCRSDT=$GET(GMRCTIU(+GMRCRSLT,1201,"E"))
+21 ;I GMRCCPT=GMRCRSPT K GMRCTIU(+GMRCRSLT)
End DoDot:3
IF +GMRCERR
QUIT
+22 IF $PIECE(GMRCRSLT,";",2)'="TIU(8925,"
Begin DoDot:3
+23 SET X=$PIECE($PIECE($PIECE(GMRCRSLT,";",2),",",1),"(",2)
+24 IF X'=699
IF X'=699.5
SET GMRCRSPT=$$GET1^DIQ(X,+GMRCRSLT,1,"I")
+25 IF X=699!(X=699.5)
SET GMRCRSPT=$$GET1^DIQ(X,+GMRCRSLT,.02,"I")
+26 IF $GET(GMRCRSPT)'=""
SET GMRCRSPT=$$GET1^DIQ(690,GMRCRSPT,.01,"I")
+27 IF X=698!(X=698.1)!(X=698.2)!(X=698.3)!(X=701)
SET GMRCRSDT=$$GET1^DIQ(X,+GMRCRSLT,.01,"E")
+28 IF X'=698
IF X'=698.1
IF X'=698.2
IF X'=698.3
IF X'=701
Begin DoDot:4
+29 SET GMRCRSDT=$$GET1^DIQ(X,+GMRCRSLT,1502,"E")
+30 IF GMRCRSDT=""
SET GMRCRSDT=$$GET1^DIQ(X,+GMRCRSLT,.01,"E")
End DoDot:4
End DoDot:3
+31 ;stored correctly
IF GMRCCPT=GMRCRSPT
QUIT
+32 ;For this report, we will quit if any patient iens are not found
+33 ;S GMRCRSPT="<NO IEN FOUND>"
IF GMRCRSPT=""
QUIT
+34 ;S GMRCCPT="<NO IEN FOUND>"
IF GMRCCPT=""
QUIT
+35 ;
+36 SET GMRCOERR=$PIECE(GMRC0,U,3)
+37 IF GMRCOERR'=""
SET GMRCNAME=$PIECE($$OI^ORX8(GMRCOERR),U,2)
+38 IF GMRCNAME=""
IF +$PIECE(GMRC0,U,8)
Begin DoDot:3
+39 NEW GMRCPTR,GMRCFL,GMRCPRC
+40 SET GMRCPRC=$PIECE(GMRC0,U,8)
SET GMRCPTR=+GMRCPRC
SET GMRCFL=$PIECE(GMRCPRC,";",2)
+41 IF +GMRCPTR
IF GMRCFL'=""
SET GMRCPRC="^"_GMRCFL_GMRCPTR_",0)"
Begin DoDot:4
+42 SET GMRCNAME=$PIECE($GET(@GMRCPRC),U,1)
End DoDot:4
End DoDot:3
+43 IF GMRCNAME=""
SET GMRCNAME=$PIECE($GET(^GMR(123.5,$PIECE(GMRC0,U,5),0)),U,1)
+44 SET GMRCLOC=+$PIECE(GMRC0,U,4)
+45 SET GMRCDIV=+$PIECE($GET(^SC(GMRCLOC,0)),U,4)
+46 SET GMRCTTL=GMRCTTL+1
+47 IF GMRCDT=""
SET GMRCDTX="NO DATE "_GMRCTTL
+48 SET ^TMP("GMRCYP70",$JOB,GMRCDIV,GMRCCNST,GMRCDTX,GMRCTTL)=GMRCCNST_U_GMRCNAME_U_GMRCDT_U_GMRCCPT_U_GMRCRSPT_U_GMRCTYPE_U_+GMRCRSLT_U_GMRCRSDT_U_XCNT
End DoDot:2
End DoDot:1
+49 QUIT
+50 ;
MSG ;Send Mailman message to installer
+1 NEW GMRC0,GMRCIEN,GMRCC,GMRCCNT,GMRCTPT,GMRCDT,GMRCFDT,GMRCRDT,GMRCNAME
+2 NEW GMRCPFLG,GMRCCPT,GMRCTYPE,GMRCDOC,GMRCCON,GMRCX,GMRCMSG,GMRCPARM
+3 NEW GMRCPG,GMRCSPC,GMRCTPG,GMRCTXT,GMRCDIV,GMRCEDIV,GMRCSIEN,GMRCRTTL
+4 NEW XMDUZ,XMERR,XMSUB,XMTEXT,XMY,Y
+5 SET (GMRCCON,GMRCNAME,GMRCCPT,GMRCTPT,GMRCDOC,GMRCTYPE)=""
+6 IF $DATA(GMRCRECP)
MERGE XMY=GMRCRECP
+7 IF DUZ=""
NEW DUZ
SET DUZ=.5
+8 SET XMDUZ=DUZ
SET XMTEXT="GMRCTXT"
+9 SET XMY(DUZ)=""
+10 Begin DoDot:1
+11 SET GMRCPG=0
SET GMRCDIV=""
SET GMRCSIEN=""
+12 DO TOTAL
+13 SET GMRCTPG=GMRCRTTL/500
IF GMRCTPG#1
SET GMRCTPG=$PIECE(GMRCTPG,".")+1
+14 FOR GMRCPG=1:1:GMRCTPG
Begin DoDot:2
+15 KILL GMRCTXT
+16 SET GMRCC=0
+17 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="This message ("_GMRCPG_" of "_GMRCTPG_") has been sent by routine GMRCYP70 at the completion"
+18 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="of the Consult Result evaluation."
+19 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
+20 SET XMSUB="CONSULT NOTE ON WRONG PATIENT (MSG "_GMRCPG_" of "_GMRCTPG_")"
+21 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="In the report below, the patient IEN from the ASSOCIATED RESULTS file (8925,"
+22 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="691, 691.1, etc.) does not match the patient IEN stored on the consult"
+23 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="in the REQUEST/CONSULTATION file."
+24 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
+25 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="A team including a Clinical Application Coordinator, Chief, Health"
+26 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="Information Management, and other pertinent facility staff should"
+27 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="review the results of the report generated by this patch. This step is"
+28 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="critical to ensuring the integrity and accuracy of the Consult data at"
+29 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="your facility."
+30 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
+31 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="See the description for patch GMRC*3.0*70 in the National Patch Module"
+32 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="for further explanation of this report and for instructions on how to"
+33 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="correct the listed entries."
+34 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
+35 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
+36 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" CONSULT # CONSULT NAME CONSULT DATE/TIME "
+37 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" CONSULT PT IEN # RESULT PT IEN # RESULT TYPE RESULT DOC # "
+38 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" RESULT DATE/TIME "
+39 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="============================================================================="
+40 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
+41 SET GMRCSPC=" "
+42 SET GMRCCNT=0
SET GMRCPFLG=0
+43 IF +$GET(GMRCSIEN)
SET GMRCDIV=GMRCDIV-1
+44 FOR
SET GMRCDIV=$ORDER(^TMP("GMRCYP70",$JOB,GMRCDIV))
if GMRCDIV=""
QUIT
Begin DoDot:3
+45 IF GMRCCNT'=0
Begin DoDot:4
+46 NEW I
+47 FOR I=1:1:3
SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
End DoDot:4
+48 SET GMRCEDIV=$$EXTERNAL^DILFD(44,3,"",GMRCDIV)
+49 IF GMRCEDIV']""
SET GMRCEDIV="UNKNOWN"
+50 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="-----------------------------------------------------------------------------"
+51 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="Division: "_GMRCEDIV
+52 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="-----------------------------------------------------------------------------"
+53 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
+54 IF '+$GET(GMRCSIEN)
SET GMRCIEN=""
+55 IF +$GET(GMRCSIEN)
SET GMRCSIEN=""
+56 FOR
SET GMRCIEN=$ORDER(^TMP("GMRCYP70",$JOB,GMRCDIV,GMRCIEN))
if GMRCIEN=""
QUIT
Begin DoDot:4
+57 SET GMRCDT=""
+58 FOR
SET GMRCDT=$ORDER(^TMP("GMRCYP70",$JOB,GMRCDIV,GMRCIEN,GMRCDT))
if GMRCDT=""
QUIT
Begin DoDot:5
+59 SET GMRCX=""
+60 FOR
SET GMRCX=$ORDER(^TMP("GMRCYP70",$JOB,GMRCDIV,GMRCIEN,GMRCDT,GMRCX))
if GMRCX=""
QUIT
Begin DoDot:6
+61 SET GMRC0=$GET(^TMP("GMRCYP70",$JOB,GMRCDIV,GMRCIEN,GMRCDT,GMRCX))
+62 ;SET DATE
SET Y=$PIECE(GMRC0,"^",3)
+63 DO DD^%DT
+64 IF Y=-1
SET Y="DATE ERROR"
+65 SET GMRCFDT=Y
+66 SET GMRCCON=$EXTRACT(GMRCIEN_GMRCSPC,1,15)
+67 SET GMRCFDT=$EXTRACT(GMRCFDT_GMRCSPC,1,18)
+68 SET GMRCNAME=$EXTRACT($PIECE(GMRC0,U,2)_GMRCSPC,1,23)_" "
+69 SET GMRCCPT=$EXTRACT($PIECE(GMRC0,U,4)_GMRCSPC,1,21)
+70 SET GMRCTPT=$EXTRACT($PIECE(GMRC0,U,5)_GMRCSPC,1,19)
+71 SET GMRCTYPE=$EXTRACT($PIECE(GMRC0,U,6)_GMRCSPC,1,16)
+72 SET GMRCDOC=$EXTRACT($PIECE(GMRC0,U,7)_GMRCSPC,1,20)
+73 SET GMRCRDT=$EXTRACT($PIECE(GMRC0,U,8)_GMRCSPC,1,21)
+74 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "_GMRCCON_GMRCNAME_GMRCFDT
+75 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "_GMRCCPT_GMRCTPT_GMRCTYPE_GMRCDOC
+76 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "_GMRCRDT
+77 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
+78 SET GMRCCNT=GMRCCNT+1
End DoDot:6
End DoDot:5
+79 IF GMRCCNT>499
Begin DoDot:5
+80 IF +$ORDER(^TMP("GMRCYP70",$JOB,GMRCDIV,GMRCIEN))
SET GMRCSIEN=GMRCIEN
+81 SET GMRCPFLG=1
End DoDot:5
End DoDot:4
if +GMRCPFLG
QUIT
End DoDot:3
if GMRCCNT>497
QUIT
+82 IF GMRCCNT=0
QUIT
+83 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
+84 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
+85 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="Total records searched: "_XCNT
+86 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="Total records in this message: "_GMRCCNT
+87 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="Total records attached to wrong patient: "_GMRCTTL
+88 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.GMRCPARM,"","")
+89 SET GMRCMSG(1)=" "
+90 SET GMRCMSG(2)="******************************************************************************"
+91 Begin DoDot:3
+92 SET GMRCMSG(3)="** Message ("_$SELECT($LENGTH(GMRCPG)=1:$JUSTIFY("0"_GMRCPG,2),1:GMRCPG)_" of "_$SELECT($LENGTH(GMRCTPG)=1:$JUSTIFY("0"_GMRCTPG,2),1:GMRCTPG)_") containing Consult records which have a consult result**"
+93 IF '$DATA(XMERR)
SET GMRCMSG(4)="** attached to the wrong patient. **"
+94 IF $DATA(XMERR)
Begin DoDot:4
+95 SET GMRCMSG(4)="** attached to the wrong patient was NOT sent. **"
+96 SET GMRCMSG(5)="** The message was not sent due to an error in the message setup. **"
+97 SET GMRCMSG(6)="** Dumping message to screen. **"
+98 SET GMRCMSG(7)="******************************************************************************"
End DoDot:4
End DoDot:3
+99 IF '$DATA(XMERR)
SET GMRCMSG(5)="******************************************************************************"
End DoDot:2
+100 KILL ^TMP("GMRCYP70",$JOB)
End DoDot:1
+101 QUIT
+102 ;
NOMSG ;Send Mailman message to installer - no records found
+1 NEW GMRCC,GMRCMSG,GMRCPARM,GMRCSPC,GMRCTXT
+2 NEW XMDUZ,XMERR,XMSUB,XMTEXT,XMY,Y
+3 IF DUZ=""
NEW DUZ
SET DUZ=.5
+4 SET XMDUZ=DUZ
SET XMTEXT="GMRCTXT"
+5 SET XMY(DUZ)=""
+6 KILL GMRCTXT
+7 SET GMRCC=0
+8 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="This message has been sent by routine GMRCYP70 at the completion"
+9 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="of the Consult Result evaluation."
+10 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)=" "
+11 SET XMSUB="NO MATCHES FOUND - CONSULT RESULTS"
+12 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="All Consult Results are attached to the correct patient."
+13 SET GMRCSPC=" "
+14 SET GMRCC=GMRCC+1
SET GMRCTXT(GMRCC)="Total records attached to wrong patient: "_$GET(GMRCTTL)
+15 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.GMRCPARM,"","")
+16 SET GMRCMSG(1)=" "
+17 SET GMRCMSG(2)="******************************************************************************"
+18 SET GMRCMSG(3)="** Message containing Consult records which have a Consult Result **"
+19 IF '$DATA(XMERR)
SET GMRCMSG(4)="** attached to the wrong Patient was sent. **"
+20 IF $DATA(XMERR)
Begin DoDot:1
+21 SET GMRCMSG(4)="** attached to the wrong patient was NOT sent. **"
+22 SET GMRCMSG(5)="** The message was not sent due to an error in the message setup. **"
+23 SET GMRCMSG(6)="** Dumping message to screen. **"
+24 SET GMRCMSG(7)="******************************************************************************"
End DoDot:1
+25 IF '$DATA(XMERR)
SET GMRCMSG(5)="******************************************************************************"
+26 QUIT
+27 ;
TOTAL ;Calculate adjusted result totals to determine total messages needed
+1 NEW GMRCDIV,GMRCDT,GMRCIEN,GMRCTCNT,GMRCX
+2 SET GMRCRTTL=0
+3 SET GMRCDIV=""
TOTAL1 SET (GMRCTCNT,GMRCPFLG)=0
+1 Begin DoDot:1
+2 IF +$GET(GMRCSIEN)
SET GMRCDIV=GMRCDIV-1
+3 FOR
SET GMRCDIV=$ORDER(^TMP("GMRCYP70",$JOB,GMRCDIV))
if GMRCDIV=""
QUIT
Begin DoDot:2
+4 IF '+$GET(GMRCSIEN)
SET GMRCIEN=""
+5 IF +$GET(GMRCSIEN)
SET GMRCSIEN=""
+6 FOR
SET GMRCIEN=$ORDER(^TMP("GMRCYP70",$JOB,GMRCDIV,GMRCIEN))
if GMRCIEN=""
QUIT
Begin DoDot:3
+7 SET GMRCDT=""
+8 FOR
SET GMRCDT=$ORDER(^TMP("GMRCYP70",$JOB,GMRCDIV,GMRCIEN,GMRCDT))
if GMRCDT=""
QUIT
Begin DoDot:4
+9 SET GMRCX=""
+10 FOR
SET GMRCX=$ORDER(^TMP("GMRCYP70",$JOB,GMRCDIV,GMRCIEN,GMRCDT,GMRCX))
if GMRCX=""
QUIT
Begin DoDot:5
+11 SET GMRCTCNT=GMRCTCNT+1
End DoDot:5
End DoDot:4
+12 IF GMRCTCNT>499
Begin DoDot:4
+13 IF +$ORDER(^TMP("GMRCYP70",$JOB,GMRCDIV,GMRCIEN))
SET GMRCSIEN=GMRCIEN
+14 SET GMRCPFLG=1
+15 SET GMRCRTTL=GMRCRTTL+1
End DoDot:4
End DoDot:3
if +GMRCPFLG
QUIT
End DoDot:2
if GMRCTCNT>497
QUIT
+16 IF GMRCTCNT<500
SET GMRCRTTL=GMRCRTTL+GMRCTCNT
End DoDot:1
+17 if GMRCDIV'=""
GOTO TOTAL1
+18 QUIT
+19 ;
NAMELIST(GMRCP,GMRCOLD,GMRCDELR) ;manage the list of recipients
+1 ;
+2 ; GMRCP - Prompt
+3 ; GMRCOLD - Original list with ordering provider.
+4 ; GMRCDELR - 1 means the original list may have names deleted
+5 ; Returns final list in GMRCOLD array
+6 ;
+7 NEW GMRCNEW,GMRCNT,GMRCDUZ,GMRCUSER,GMRCQ,GMRCADD,DIC,X,Y
+8 MERGE GMRCNEW=GMRCOLD
+9 ;Remove mandatory users from GMRCOLD
IF GMRCDELR=1
KILL GMRCOLD
SET GMRCOLD=""
+10 SET GMRCNT=0
FOR
Begin DoDot:1
+11 SET GMRCUSER=$$READ("FAO;3;46",GMRCP,"","^D NAMEHELP^GMRCYP70")
+12 if '$LENGTH(GMRCUSER)
SET GMRCUSER=U
if (GMRCUSER[U)
QUIT
+13 IF ($EXTRACT(GMRCUSER,1)="-")
SET GMRCADD=0
SET GMRCUSER=$EXTRACT(GMRCUSER,2,$LENGTH(GMRCUSER))
+14 IF '$TEST
SET GMRCADD=1
+15 SET X=GMRCUSER
SET DIC=200
SET DIC(0)="EMQ"
DO ^DIC
+16 IF (Y>0)
Begin DoDot:2
+17 IF GMRCADD
Begin DoDot:3
+18 IF $DATA(GMRCNEW(+Y))
DO MES^XPDUTL(" already in the list.")
QUIT
+19 SET GMRCNEW(+Y)=""
DO MES^XPDUTL(" added to the list.")
SET GMRCNT=GMRCNT+1
End DoDot:3
+20 IF 'GMRCADD
Begin DoDot:3
+21 IF $DATA(GMRCOLD(+Y))
DO MES^XPDUTL(" can't delete this name from the list.")
QUIT
+22 IF '$DATA(GMRCNEW(+Y))
DO MES^XPDUTL(" not currently in the list.")
QUIT
+23 KILL GMRCNEW(+Y)
SET GMRCNT=GMRCNT-1
DO MES^XPDUTL(" deleted from the list.")
End DoDot:3
End DoDot:2
IF 1
+24 IF '$TEST
IF $LENGTH(GMRCUSER)
DO MES^XPDUTL(" Name not found.")
+25 DO MES^XPDUTL(" ")
End DoDot:1
if (GMRCUSER[U)
QUIT
+26 MERGE GMRCOLD=GMRCNEW
+27 QUIT
+28 ;
READ(GMRC0,GMRCA,GMRCB,GMRCH,GMRCL) ;read logic
+1 ;
+2 ; GMRC0 -> DIR(0) --- Type of read
+3 ; GMRCA -> DIR("A") - Prompt
+4 ; GMRCB -> DIR("B") - Default Answer
+5 ; GMRCH -> DIR("?") - Help text or ^Execute code
+6 ; GMRCL -> Number of blank lines to put before Prompt
+7 ;
+8 ; Returns "^" or answer
+9 ;
+10 NEW GMRCLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
+11 if '$LENGTH($GET(GMRC0))
QUIT U
+12 SET DIR(0)=GMRC0
+13 if $LENGTH($GET(GMRCA))
SET DIR("A")=GMRCA
+14 if $LENGTH($GET(GMRCB))
SET DIR("B")=GMRCB
+15 if $LENGTH($GET(GMRCH))
SET DIR("?")=GMRCH
+16 FOR GMRCLINE=1:1:($GET(GMRCL)-1)
WRITE !
+17 DO ^DIR
+18 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT U
+19 QUIT Y
+20 ;
+21 ;
NAMEHELP ;Help for the recipient list logic
+1 NEW GMRCDUZ
+2 DO BMES^XPDUTL("Enter the name of the user to send the message to,")
+3 DO MES^XPDUTL(" or put a '-' in front of a name to delete from the list.")
+4 DO MES^XPDUTL(" ")
+5 DO MES^XPDUTL(" Example:")
+6 DO BMES^XPDUTL(" SMITH,FRED -> to add Fred to the list.")
+7 DO MES^XPDUTL(" -SMITH,FRED -> to delete Fred from the list.")
+8 DO BMES^XPDUTL("Already selected: ")
+9 DO MES^XPDUTL(" ")
+10 SET GMRCDUZ=0
FOR
SET GMRCDUZ=$ORDER(GMRCNEW(GMRCDUZ))
if 'GMRCDUZ
QUIT
Begin DoDot:1
+11 IF '$DATA(GMRCOLD(GMRCDUZ))
DO MES^XPDUTL(" "_$PIECE(^VA(200,GMRCDUZ,0),U,1))
+12 IF $DATA(GMRCOLD(GMRCDUZ))
DO MES^XPDUTL(" "_$PIECE(^VA(200,GMRCDUZ,0),U,1)_" <mandatory>")
End DoDot:1
+13 DO MES^XPDUTL(" ")
+14 QUIT
