PXRMSTS ;SLC/PKR,AGP - Master File Server event handling routines. 09/01/2021
;;2.0;CLINICAL REMINDERS;**12,17,18,26,45,65**;Feb 04, 2005;Build 438
;
; API ICR
;$$GETSTAT^HDISVF01 4640
;GETSTAT^XTID 4631
;==============================
AERRMSG(EMSG,NL) ;Add the UPDATE^DIE error message.
N ERRMSG,IND
D ACOPY^PXRMUTIL("MSG","ERRMSG()")
S IND=0
F S IND=$O(ERRMSG(IND)) Q:IND="" S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=ERRMSG(IND)
Q
;
;==============================
ATFND(IEN,FI,REP,NL) ;Add the replacement as a new finding to the term.
N DA,DIK,EMSG,GBL,NEWFI,TEXT
S GBL=$P($$GET1^DID($P(REP,";",2),"","","GLOBAL NAME"),U,2)
S NEWFI=$P(REP,";",1)_";"_GBL
;If this finding already exists don't add it again.
I $D(^PXRMD(811.5,IEN,20,"B",NEWFI)) Q
S DA(1)=IEN,DIK="^PXRMD(811.5,"_IEN_",20,"
D SETSTART^PXRMCOPY(DIK)
S DA=$$GETFOIEN^PXRMCOPY(DIK)
M ^PXRMD(811.5,IEN,20,DA)=^PXRMD(811.5,IEN,20,FI)
S $P(^PXRMD(811.5,IEN,20,DA,0),U,1)=NEWFI
D IX^DIK
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Replacement added as finding number "_DA
S TEXT(1)="STS protocol automated update."
S TEXT(2)="Replacement added as finding number "_DA_"."
D UPEHIST^PXRMUTIL(811.5,IEN,.TEXT,.EMSG)
I $D(EMSG) D
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Edit history update failed."
. D AERRMSG(.EMSG,.NL)
Q
;
;==============================
BLDDLGEH(MSG,IEN,TEXT) ;
N CNT
I '$D(MSG(IEN)) S MSG(IEN,1)=TEXT Q
S CNT=""
S CNT=$O(MSG(IEN,CNT),-1)
S CNT=CNT+1,MSG(IEN,CNT)=TEXT
Q
;
;==============================
BLDDLGTM(SUB) ;Build an index of dialog finding usage.
N AFIND,AIEN,FIELD,FIEN,FIND,GBL,IDX,IEN,MH,NODE,ORD,SEQ,TYPE
K ^TMP($J,SUB)
S IEN=0 F S IEN=$O(^PXRMD(801.41,IEN)) Q:IEN'>0 D
.S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
.I TYPE'="E",TYPE'="G",TYPE'="S" Q
.S NODE=$G(^PXRMD(801.41,IEN,1))
.S FIND=$P(NODE,U,5)
.S ORD=$P(NODE,U,7)
.I FIND'="" D
..S FIEN=$P(FIND,";"),GBL=$P(FIND,";",2)
..S ^TMP($J,SUB,GBL,FIEN,IEN,15)=""
.I ORD'="" S ^TMP($J,SUB,"ORD(101.43,",ORD,IEN,17)=""
.S MH=$P($G(^PXRMD(801.41,IEN,50)),U)
.I MH'="" S ^TMP($J,SUB,"YTT(601.71,",MH,IEN,119)=""
.S AFIND=0
.F S AFIND=$O(^PXRMD(801.41,IEN,3,"B",AFIND)) Q:AFIND="" D
..S AIEN=$O(^PXRMD(801.41,IEN,3,"B",AFIND,"")) Q:AIEN'>0
..S FIEN=$P(AFIND,";"),GBL=$P(AFIND,";",2)
..S ^TMP($J,SUB,GBL,FIEN,IEN,18,AIEN)=""
.;check branching logic sequences for reminder definition and reminder terms
.S IDX=0 F S IDX=$O(^PXRMD(801.41,IEN,"BL",IDX)) Q:IDX'>0 D
..S NODE=$G(^PXRMD(801.41,IEN,"BL",IDX,0))
..S FIND=$P(NODE,U,2),SEQ=$P(NODE,U)
..S GBL=$P(FIND,";",2),FIEN=$P(FIND,";")
..S ^TMP($J,SUB,GBL,FIEN,IEN,"BL",SEQ)=""
Q
;
BLDFINDS(FINDINGS) ;
N FILE,TFIND,TYPE
D RFIND^PXRMFRPT(.TFIND)
D DFIND^PXRMFRPT(.TFIND)
S TYPE="" F S TYPE=$O(TFIND(TYPE)) Q:TYPE="" D
.S FILE=$G(TFIND(TYPE)) Q:TYPE=""
.S FINDINGS(FILE)=""
Q
;
;==============================
DEF(FILENUM,GBL,FIEN,REP,MAPACT,NL) ;Search all reminder definitions
;for any that are using this finding, defined by the global (GBL) and
;the IEN (FIEN).
N DEF,FI,IEN,TERM
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" It is used in the following definitions:"
I '$D(^TMP($J,"FDATA",FILENUM,FIEN,"DEF")) S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None" Q
S TERM=$S(MAPACT="M":$$GENTERM(FILENUM,FIEN,REP,.NL),1:0)
S IEN=0
F S IEN=$O(^TMP($J,"FDATA",FILENUM,FIEN,"DEF",IEN)) Q:IEN="" D
. S DEF=$P(^PXD(811.9,IEN,0),U,1)
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_DEF_" IEN="_IEN
. S FI=""
. F S FI=$O(^TMP($J,"FDATA",FILENUM,FIEN,"DEF",IEN,FI)) Q:FI="" D
.. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Finding number "_FI
.. I MAPACT="M",TERM>0 D RFWT(IEN,FI,TERM,.NL)
Q
;
;==================================================================
DIALOG(FILENUM,GBL,FIEN,REPA,REPB,MAPACT,DSUB,DLGUNMP,STATUS,NL) ;
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
N AIEN,DA,DIE,DISABLE,DISTXT,DR,DIEN,EDITHIS,EDTEXT,FIELD,FIELDNAM
N FILESTAT,FINDNAME,ISLOCK,LOCK,NAME,NODE,TEXT,TYPE
;
I MAPACT'="U" S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" It is used in the following dialogs:"
;
;Unmapped write a message listing what dialog item contains the original
;term
I DLGUNMP=1 D Q
.S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" The original term is used in the following dialogs:"
.I '$D(^TMP($J,DSUB,GBL,+REPB)) S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None" Q
.S DA=0
.F S DA=$O(^TMP($J,DSUB,GBL,+REPB,DA)) Q:DA'>0 D
..S NODE=$G(^PXRMD(801.41,DA,0))
..S NAME=$P(NODE,U)
..S ISLOCK=$S(+$P(NODE,U,3)>0:1,1:0)
..S TYPE=$P(NODE,U,4)
..S DISTXT=$S(ISLOCK=1:" (DISABLED) ",1:" ")
..S TEXT="Dialog "_$S(TYPE="E":"element",TYPE="G":"group",TYPE="S":"result group",1:"item")
..S TEXT=" "_TEXT_" "_NAME_DISTXT_"IEN="_DA
..S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
;
I '$D(^TMP($J,DSUB,GBL,FIEN)) S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None" Q
S DIE="^PXRMD(801.41,",DISABLE=1
S DR="3////^S X=DISABLE"
S FILESTAT=+$$GETSTAT^HDISVF01(FILENUM)
S LOCK=$S(FILESTAT=6:1,1:0)
;
;No replacement list dialog names, if file status of 6 disable the
;dialog items if the term is inactive
I MAPACT="N" D G DIALOGX
.S DA=0
.F S DA=$O(^TMP($J,DSUB,GBL,FIEN,DA)) Q:DA'>0 D
..S NODE=$G(^PXRMD(801.41,DA,0))
..S NAME=$P(NODE,U)
..S ISLOCK=$S(+$P(NODE,U,3)>0:1,1:0)
..S TYPE=$P(NODE,U,4)
..S DISTXT=$S(ISLOCK=1:" (DISABLED) ",1:" ")
..S TEXT="Dialog "_$S(TYPE="E":"element",TYPE="G":"group",TYPE="S":"result group",1:"item")
..;
..;File in state 6, dialog item not already disable, and finding item
..;is inactive
..I LOCK=1,ISLOCK=0,+STATUS=0 D
...S DISTXT=" (MADE INACTIVE) "
...D ^DIE
...S FINDNAME=$$GET1^DIQ(FILENUM,FIEN,.01,"","","")
...S EDTEXT="Disabled for inactive item "_FINDNAME
...D BLDDLGEH(.EDITHIS,DA,EDTEXT)
..S TEXT=" "_TEXT_" "_NAME_DISTXT_"IEN="_DA
..S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
;
;Do if MAPACT="M", only update items if file status is 6.
I FILESTAT'=6 Q
;I FILESTAT'=6,FILESTAT'=7 Q
S DA=0
F S DA=$O(^TMP($J,DSUB,GBL,FIEN,DA)) Q:DA'>0 D
.S NAME=$P(^PXRMD(801.41,DA,0),U)
.S TYPE=$P(^PXRMD(801.41,DA,0),U,4)
.S TEXT="Dialog "_$S(TYPE="E":"element",TYPE="G":"group",TYPE="S":"result group",1:"item")_" "_NAME
.S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_TEXT
.;
.S FIELD=0
.F S FIELD=$O(^TMP($J,DSUB,GBL,FIEN,DA,FIELD)) Q:FIELD'>0 D
..;additional loop for additional findings
..I FIELD=18 D Q
...S AIEN=0
...F S AIEN=$O(^TMP($J,DSUB,GBL,FIEN,DA,FIELD,AIEN)) Q:AIEN'>0 D
....D DIALUPD(FIEN,+REPA,GBL,FIELD,DA,AIEN,FILENUM,"Additional Finding item",.EDITHIS)
....S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Additional Finding item was replaced."
..;
..S FIELDNAM=$S(FIELD=15:"Finding Item",FIELD=17:"Orderable Item",FIELD=119:"MH Test",1:" ")
..D DIALUPD(FIEN,+REPA,GBL,FIELD,DA,0,FILENUM,FIELDNAM,.EDITHIS)
..S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_FIELDNAM_" was replaced."
;
DIALOGX ;
I '$D(EDITHIS) Q
N CNT,EMSG,MESTXT
S DA="" F S DA=$O(EDITHIS(DA)) Q:DA'>0 D
.K EMSG,MESTXT
.S CNT=0 F S CNT=$O(EDITHIS(DA,CNT)) Q:CNT'>0 S MESTXT(CNT)=EDITHIS(DA,CNT)
.D UPEHIST^PXRMUTIL(801.41,DA,.MESTXT,.EMSG)
.I $D(EMSG) D
..S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Edit history update failed."
..D AERRMSG(.EMSG,.NL)
Q
;
;==================================================================
DIALUPD(OLDVALUE,NEWVALUE,GBL,FIELD,DIEN,FIEN,FILENUM,FIELDNAM,EDITHIST) ;
N EMSG,FDA,FIENS,FILE,NEWNAME,OLDNAME,TEXT
S FILE=$S(FIEN>0:801.4118,1:801.41)
I FILE=801.4118 S FIELD=.01
S FIENS=$S(FIEN>0:FIEN_","_DIEN_",",1:DIEN_",")
S FDA(FILE,FIENS,FIELD)=NEWVALUE_";"_GBL
D UPDATE^DIE("","FDA","","EMSG")
I $D(MSG) D Q
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Dialog update failed."
. D AERRMSG(.EMSG,.NL)
S OLDNAME=$$GET1^DIQ(FILENUM,OLDVALUE,.01,"","","")
S NEWNAME=$$GET1^DIQ(FILENUM,NEWVALUE,.01,"","","")
S TEXT=FIELDNAM_" value "_OLDNAME_" replaced by "_NEWNAME_" for data mapping"
D BLDDLGEH(.EDITHIST,DIEN,TEXT)
Q
;
;==============================
ERROR(EVENT,NL) ;Error
N IND
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="An error occurred; error message text is -"
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_^XTMP(EVENT,"ERROR")
S IND=0
F S IND=$O(^XTMP(EVENT,"ERROR",IND)) Q:IND="" D
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_^XTMP(EVENT,"ERROR",IND)
Q
;
;==============================
EVDRVR ;Event driver for STS events.
N DEFL,DIAL,DLGUNMP,FIEN,FIENS,FILENUM,FILES,FINDINGS,FSTAT,GBL,MAPACT,NL
N REPA,REPB,STATUS,TYPE,OLDSTATUS
S ZTREQ="@"
K ^TMP($J,"DLG FIND"),^TMP($J,"FDATA"),^TMP($J,"PXRM DIALOGS"),^TMP("PXRMXMZ",$J)
D BLDDLGTM("DLG FIND")
D BLDFINDS(.FINDINGS)
S NL=1,^TMP("PXRMXMZ",$J,NL,0)="Protocol event summary:"
;Check for error.
I $D(^XTMP(EVENT,"ERROR")) D ERROR(EVENT,.NL) G SEND
S FILENUM=0
F S FILENUM=$O(^XTMP(EVENT,FILENUM)) Q:FILENUM="" D
.;Skip the STANDARD TERMINOLOGY VERSION FILE, it is not relevant
.;for Clinical Reminders.
. I FILENUM=4.009 Q
. I '$D(FINDINGS(FILENUM)) Q
. S FSTAT=$P($$GETSTAT^HDISVF01(FILENUM),U,1)
. S GBL=$P($$GET1^DID(FILENUM,"","","GLOBAL NAME"),U,2)
. S TYPE=""
. F S TYPE=$O(^XTMP(EVENT,FILENUM,TYPE)) Q:TYPE="" D
.. I TYPE="STATUS" Q
.. S FIEN=""
.. F S FIEN=$O(^XTMP(EVENT,FILENUM,TYPE,FIEN)) Q:FIEN="" D
... I FILENUM=9999999.14,FIEN=$$IMMNODEF^PXAPIIM() Q
...;Call processing routines.
... S FIENS=FIEN_","
... S STATUS=$$GETSTAT^XTID(FILENUM,"",FIENS)
... I $P(STATUS,U,3)="" S $P(STATUS,U,3)="UNDEFINED"
... S OLDSTATUS=""
... I $G(^XTMP(EVENT,FILENUM,"STATUS",FIEN))'="" D
.... S OLDSTATUS=$P(^XTMP(EVENT,FILENUM,"STATUS",FIEN),U,1,2)
.... ;S OLDSTATUS=OLDSTATUS_U_$$EXTERNAL^DILFD(9999999.1499,.02,"",+OLDSTATUS)
... I TYPE="NEW" D NEW(EVENT,FILENUM,FIEN,STATUS,.NL) Q
... I TYPE="BEFORE" Q
... I TYPE'="AFTER" D UNKNOWN(TYPE,.NL) Q
... S REPA=$G(^XTMP(EVENT,FILENUM,"AFTER",FIEN,"INHERITS FROM"))
... S REPB=$G(^XTMP(EVENT,FILENUM,"BEFORE",FIEN,"INHERITS FROM"))
...;MAP ACTION can be M (map) or U (unmap) or N (none).
...;Set the map action for displaying the status.
... S MAPACT=$S(REPA=REPB:"N",REPA'=(FIEN_";"_FILENUM):"M",1:"U")
... ; if nothing was changed, don?t need to include it.
... I '$D(^XTMP(EVENT,FILENUM,"AFTER",FIEN,0)),MAPACT="N" Q
... D STATUSTX(MAPACT,FILENUM,FIEN,REPA,REPB,OLDSTATUS,STATUS,.NL)
... S DLGUNMP=$S(MAPACT="U":1,1:0)
...;Unless the file status is 6 do not do any automatic replacements.
... S MAPACT=$S(FSTAT'=6:"N",1:MAPACT)
...;Process the lists, doing replacements updates etc. and generate
...;a MailMan message describing what was done.
... D DEFLIST^PXRMFRPT(FILENUM,GBL,FIEN,"FDATA")
... D DEF(FILENUM,GBL,FIEN,REPA,MAPACT,.NL)
... D TERMLIST^PXRMFRPT(FILENUM,GBL,FIEN,"FDATA")
... D TERM(FILENUM,GBL,FIEN,REPA,MAPACT,.NL)
... D DIALOG(FILENUM,GBL,FIEN,REPA,REPB,MAPACT,"DLG FIND",DLGUNMP,STATUS,.NL)
;
; If there is no content, don't send the message
I NL=1 Q
;
;Deliver the MailMan message.
SEND D SEND^PXRMMSG("PXRMXMZ",SUBJECT,"",DUZ)
K ^TMP($J,"DLG FIND"),^TMP($J,"FDATA"),^TMP($J,"PXRM DIALOGS"),^TMP("PXRMXMZ",$J),^XTMP(EVENT)
Q
;
;==============================
GENTERM(FILENUM,IEN,REP,NL) ;Generate a term that contains the original
;definition finding and its replacement as mapped findings.
N EMSG,FDA,FINDING,ROOT,TEMP,TEXT,TIEN,TIENS,TNAME,WPTMP
S TNAME=$$GENTNAME(FILENUM,IEN)
S TEMP="^PXRMD(811.5,"
D SETSTART^PXRMCOPY(TEMP)
S TIEN=$$GETFOIEN^PXRMCOPY(TEMP)
S TIENS="+"_TIEN_","
S FINDING=REP
S ROOT=$P($$ROOT^DILFD(FILENUM),"^",2)
S $P(FINDING,";",2)=ROOT
S FDA(811.5,TIENS,.01)=TNAME
S FDA(811.5,TIENS,.04)=DT
S FDA(811.5,TIENS,100)="L"
S FDA(811.5,TIENS,1)="WPTMP(1,1)"
S WPTMP(1,1,1)="Autogenerated during STS protocol processing."
S FDA(811.52,"+1,"_TIENS,.01)=FIEN_";"_ROOT
S FDA(811.52,"+2,"_TIENS,.01)=FINDING
S FDA(811.53,"+3,"_TIENS,.01)=$$NOW^XLFDT
S FDA(811.53,"+3,"_TIENS,1)=$G(DUZ)
S FDA(811.53,"+3,"_TIENS,2)="WPTMP(1,1)"
D UPDATE^DIE("","FDA","","EMSG")
I $D(EMSG) D Q 0
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Term creation failed."
. D AERRMSG(.EMSG,.NL)
Q TIEN_";"_TNAME
;
;==============================
GENTNAME(FILENUM,IEN) ;Generate a new term name to use. Create it based on
;the original definition finding.
N ABBR,FNAME,NLEN,TEMP,TNAME,TSTAMP
S FNAME=$$GET1^DIQ(FILENUM,IEN,.01)
;DBIA #2991, #5149 for access to ^DD.
S TEMP=$O(^DD(811.902,.01,"V","B",FILENUM,""))
S ABBR=$P(^DD(811.902,.01,"V",TEMP,0),U,4)
S TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
;Calculate the number of characters from the .01 we can use.
;AUTOGENERATED ABBR-NAME TIMESTAMP
S NLEN=48-$L(ABBR)-$L(TSTAMP)
S TNAME="AUTOGENERATED "_ABBR_"-"_$E(FNAME,1,NLEN)_" "_TSTAMP
Q TNAME
;
;==============================
NEW(EVENT,FILENUM,FIEN,STATUS,NL) ;New entry in file.
N FNAME,NAME
S FNAME=$$GET1^DID(FILENUM,"","","NAME")
S NAME=$P(^XTMP(EVENT,FILENUM,"NEW",FIEN,0),U,1)
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="======================================================"
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Added new "_FNAME_" named "_NAME_" status is "_$P(STATUS,U,3)
Q
;
;==============================
RFWT(IEN,FI,TERM,NL) ;Definition finding has a replacement; change the
;finding to a term that is mapped to the original replacement and
;its replacement.
N EMSG,FDA,TEXT
S FDA(811.902,FI_","_IEN_",",.01)=$P(TERM,";",1)_";PXRMD(811.5,"
D FILE^DIE("","FDA","EMSG")
I $D(MSG) D
. N ERRMSG,IND
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Error changing finding to term."
. D AERRMSG(.EMSG,.NL)
E S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Finding number "_FI_" changed to RT."_$P(TERM,";",2)
S TEXT(1)="STS protocol automated update."
S TEXT(2)="Finding number "_FI_" changed to RT."_$P(TERM,";",2)_"."
D UPEHIST^PXRMUTIL(811.9,IEN,.TEXT,.EMSG)
I $D(EMSG) D
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Edit history update failed."
. D AERRMSG(.EMSG,.NL)
Q
;
;==============================
STATUSTX(MAPACT,FILENUM,FIEN,REPA,REPB,OLDSTATUS,STATUS,NL) ;Generate the status text.
N ABBR,FNAME,NAME,RFNAME,RFNUM,RIEN,RNAME,TEMP
S FNAME=$$GET1^DID(FILENUM,"","","NAME")
S NAME=$$GET1^DIQ(FILENUM,FIEN,.01)
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="======================================================"
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=FNAME_" entry "_NAME_" status "_$S(OLDSTATUS'=""&(+OLDSTATUS'=+STATUS):"was changed to ",1:"is ")_$P(STATUS,U,3)
I MAPACT="M" D
. S RIEN=$P(REPA,";",1)
. S RFNUM=$P(REPA,";",2)
. S RFNAME=$$GET1^DID(RFNUM,"","","NAME")
. S RNAME=$$GET1^DIQ(RFNUM,RIEN,.01)
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Its replacement is "_RFNAME_"; "_RNAME_"."
I MAPACT="U" D
. S RIEN=$P(REPB,";",1)
. S RFNUM=$P(REPB,";",2)
. S RFNAME=$$GET1^DID(RFNUM,"","","NAME")
. S RNAME=$$GET1^DIQ(RFNUM,RIEN,.01)
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" It is being unmapped; originally mapped to "_RFNAME_"; "_RNAME_"."
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" This finding may need to be manually removed."
Q
;
;==============================
TERM(FILENUM,GBL,FIEN,REP,MAPACT,NL) ;Search all reminder terms for any
;that are using this finding, defined by the global (GBL) and the
;IEN (FIEN).
N FI,IEN,TERM
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" It is used in the following terms:"
I '$D(^TMP($J,"FDATA",FILENUM,FIEN,"TERM")) S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None" Q
S IEN=0
F S IEN=$O(^TMP($J,"FDATA",FILENUM,FIEN,"TERM",IEN)) Q:IEN="" D
. S TERM=$P(^PXRMD(811.5,IEN,0),U,1)
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_TERM_" IEN="_IEN
. S FI=""
. F S FI=$O(^TMP($J,"FDATA",FILENUM,FIEN,"TERM",IEN,FI)) Q:FI="" D
.. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Finding number "_FI
.. I MAPACT="M" D ATFND(IEN,FI,REP,.NL)
Q
;
;==============================
UNKNOWN(TYPE,NL) ;Unknown event type.
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TYPE_" is an unknown event type."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMSTS 16282 printed Apr 09, 2024@20:54:20 Page 2
PXRMSTS ;SLC/PKR,AGP - Master File Server event handling routines. 09/01/2021
+1 ;;2.0;CLINICAL REMINDERS;**12,17,18,26,45,65**;Feb 04, 2005;Build 438
+2 ;
+3 ; API ICR
+4 ;$$GETSTAT^HDISVF01 4640
+5 ;GETSTAT^XTID 4631
+6 ;==============================
AERRMSG(EMSG,NL) ;Add the UPDATE^DIE error message.
+1 NEW ERRMSG,IND
+2 DO ACOPY^PXRMUTIL("MSG","ERRMSG()")
+3 SET IND=0
+4 FOR
SET IND=$ORDER(ERRMSG(IND))
if IND=""
QUIT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=ERRMSG(IND)
+5 QUIT
+6 ;
+7 ;==============================
ATFND(IEN,FI,REP,NL) ;Add the replacement as a new finding to the term.
+1 NEW DA,DIK,EMSG,GBL,NEWFI,TEXT
+2 SET GBL=$PIECE($$GET1^DID($PIECE(REP,";",2),"","","GLOBAL NAME"),U,2)
+3 SET NEWFI=$PIECE(REP,";",1)_";"_GBL
+4 ;If this finding already exists don't add it again.
+5 IF $DATA(^PXRMD(811.5,IEN,20,"B",NEWFI))
QUIT
+6 SET DA(1)=IEN
SET DIK="^PXRMD(811.5,"_IEN_",20,"
+7 DO SETSTART^PXRMCOPY(DIK)
+8 SET DA=$$GETFOIEN^PXRMCOPY(DIK)
+9 MERGE ^PXRMD(811.5,IEN,20,DA)=^PXRMD(811.5,IEN,20,FI)
+10 SET $PIECE(^PXRMD(811.5,IEN,20,DA,0),U,1)=NEWFI
+11 DO IX^DIK
+12 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Replacement added as finding number "_DA
+13 SET TEXT(1)="STS protocol automated update."
+14 SET TEXT(2)="Replacement added as finding number "_DA_"."
+15 DO UPEHIST^PXRMUTIL(811.5,IEN,.TEXT,.EMSG)
+16 IF $DATA(EMSG)
Begin DoDot:1
+17 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Edit history update failed."
+18 DO AERRMSG(.EMSG,.NL)
End DoDot:1
+19 QUIT
+20 ;
+21 ;==============================
BLDDLGEH(MSG,IEN,TEXT) ;
+1 NEW CNT
+2 IF '$DATA(MSG(IEN))
SET MSG(IEN,1)=TEXT
QUIT
+3 SET CNT=""
+4 SET CNT=$ORDER(MSG(IEN,CNT),-1)
+5 SET CNT=CNT+1
SET MSG(IEN,CNT)=TEXT
+6 QUIT
+7 ;
+8 ;==============================
BLDDLGTM(SUB) ;Build an index of dialog finding usage.
+1 NEW AFIND,AIEN,FIELD,FIEN,FIND,GBL,IDX,IEN,MH,NODE,ORD,SEQ,TYPE
+2 KILL ^TMP($JOB,SUB)
+3 SET IEN=0
FOR
SET IEN=$ORDER(^PXRMD(801.41,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+4 SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+5 IF TYPE'="E"
IF TYPE'="G"
IF TYPE'="S"
QUIT
+6 SET NODE=$GET(^PXRMD(801.41,IEN,1))
+7 SET FIND=$PIECE(NODE,U,5)
+8 SET ORD=$PIECE(NODE,U,7)
+9 IF FIND'=""
Begin DoDot:2
+10 SET FIEN=$PIECE(FIND,";")
SET GBL=$PIECE(FIND,";",2)
+11 SET ^TMP($JOB,SUB,GBL,FIEN,IEN,15)=""
End DoDot:2
+12 IF ORD'=""
SET ^TMP($JOB,SUB,"ORD(101.43,",ORD,IEN,17)=""
+13 SET MH=$PIECE($GET(^PXRMD(801.41,IEN,50)),U)
+14 IF MH'=""
SET ^TMP($JOB,SUB,"YTT(601.71,",MH,IEN,119)=""
+15 SET AFIND=0
+16 FOR
SET AFIND=$ORDER(^PXRMD(801.41,IEN,3,"B",AFIND))
if AFIND=""
QUIT
Begin DoDot:2
+17 SET AIEN=$ORDER(^PXRMD(801.41,IEN,3,"B",AFIND,""))
if AIEN'>0
QUIT
+18 SET FIEN=$PIECE(AFIND,";")
SET GBL=$PIECE(AFIND,";",2)
+19 SET ^TMP($JOB,SUB,GBL,FIEN,IEN,18,AIEN)=""
End DoDot:2
+20 ;check branching logic sequences for reminder definition and reminder terms
+21 SET IDX=0
FOR
SET IDX=$ORDER(^PXRMD(801.41,IEN,"BL",IDX))
if IDX'>0
QUIT
Begin DoDot:2
+22 SET NODE=$GET(^PXRMD(801.41,IEN,"BL",IDX,0))
+23 SET FIND=$PIECE(NODE,U,2)
SET SEQ=$PIECE(NODE,U)
+24 SET GBL=$PIECE(FIND,";",2)
SET FIEN=$PIECE(FIND,";")
+25 SET ^TMP($JOB,SUB,GBL,FIEN,IEN,"BL",SEQ)=""
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
BLDFINDS(FINDINGS) ;
+1 NEW FILE,TFIND,TYPE
+2 DO RFIND^PXRMFRPT(.TFIND)
+3 DO DFIND^PXRMFRPT(.TFIND)
+4 SET TYPE=""
FOR
SET TYPE=$ORDER(TFIND(TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+5 SET FILE=$GET(TFIND(TYPE))
if TYPE=""
QUIT
+6 SET FINDINGS(FILE)=""
End DoDot:1
+7 QUIT
+8 ;
+9 ;==============================
DEF(FILENUM,GBL,FIEN,REP,MAPACT,NL) ;Search all reminder definitions
+1 ;for any that are using this finding, defined by the global (GBL) and
+2 ;the IEN (FIEN).
+3 NEW DEF,FI,IEN,TERM
+4 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+5 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" It is used in the following definitions:"
+6 IF '$DATA(^TMP($JOB,"FDATA",FILENUM,FIEN,"DEF"))
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" None"
QUIT
+7 SET TERM=$SELECT(MAPACT="M":$$GENTERM(FILENUM,FIEN,REP,.NL),1:0)
+8 SET IEN=0
+9 FOR
SET IEN=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,"DEF",IEN))
if IEN=""
QUIT
Begin DoDot:1
+10 SET DEF=$PIECE(^PXD(811.9,IEN,0),U,1)
+11 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+12 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_DEF_" IEN="_IEN
+13 SET FI=""
+14 FOR
SET FI=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,"DEF",IEN,FI))
if FI=""
QUIT
Begin DoDot:2
+15 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Finding number "_FI
+16 IF MAPACT="M"
IF TERM>0
DO RFWT(IEN,FI,TERM,.NL)
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
+19 ;==================================================================
DIALOG(FILENUM,GBL,FIEN,REPA,REPB,MAPACT,DSUB,DLGUNMP,STATUS,NL) ;
+1 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+2 NEW AIEN,DA,DIE,DISABLE,DISTXT,DR,DIEN,EDITHIS,EDTEXT,FIELD,FIELDNAM
+3 NEW FILESTAT,FINDNAME,ISLOCK,LOCK,NAME,NODE,TEXT,TYPE
+4 ;
+5 IF MAPACT'="U"
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" It is used in the following dialogs:"
+6 ;
+7 ;Unmapped write a message listing what dialog item contains the original
+8 ;term
+9 IF DLGUNMP=1
Begin DoDot:1
+10 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" The original term is used in the following dialogs:"
+11 IF '$DATA(^TMP($JOB,DSUB,GBL,+REPB))
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" None"
QUIT
+12 SET DA=0
+13 FOR
SET DA=$ORDER(^TMP($JOB,DSUB,GBL,+REPB,DA))
if DA'>0
QUIT
Begin DoDot:2
+14 SET NODE=$GET(^PXRMD(801.41,DA,0))
+15 SET NAME=$PIECE(NODE,U)
+16 SET ISLOCK=$SELECT(+$PIECE(NODE,U,3)>0:1,1:0)
+17 SET TYPE=$PIECE(NODE,U,4)
+18 SET DISTXT=$SELECT(ISLOCK=1:" (DISABLED) ",1:" ")
+19 SET TEXT="Dialog "_$SELECT(TYPE="E":"element",TYPE="G":"group",TYPE="S":"result group",1:"item")
+20 SET TEXT=" "_TEXT_" "_NAME_DISTXT_"IEN="_DA
+21 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXT
End DoDot:2
End DoDot:1
QUIT
+22 ;
+23 IF '$DATA(^TMP($JOB,DSUB,GBL,FIEN))
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" None"
QUIT
+24 SET DIE="^PXRMD(801.41,"
SET DISABLE=1
+25 SET DR="3////^S X=DISABLE"
+26 SET FILESTAT=+$$GETSTAT^HDISVF01(FILENUM)
+27 SET LOCK=$SELECT(FILESTAT=6:1,1:0)
+28 ;
+29 ;No replacement list dialog names, if file status of 6 disable the
+30 ;dialog items if the term is inactive
+31 IF MAPACT="N"
Begin DoDot:1
+32 SET DA=0
+33 FOR
SET DA=$ORDER(^TMP($JOB,DSUB,GBL,FIEN,DA))
if DA'>0
QUIT
Begin DoDot:2
+34 SET NODE=$GET(^PXRMD(801.41,DA,0))
+35 SET NAME=$PIECE(NODE,U)
+36 SET ISLOCK=$SELECT(+$PIECE(NODE,U,3)>0:1,1:0)
+37 SET TYPE=$PIECE(NODE,U,4)
+38 SET DISTXT=$SELECT(ISLOCK=1:" (DISABLED) ",1:" ")
+39 SET TEXT="Dialog "_$SELECT(TYPE="E":"element",TYPE="G":"group",TYPE="S":"result group",1:"item")
+40 ;
+41 ;File in state 6, dialog item not already disable, and finding item
+42 ;is inactive
+43 IF LOCK=1
IF ISLOCK=0
IF +STATUS=0
Begin DoDot:3
+44 SET DISTXT=" (MADE INACTIVE) "
+45 DO ^DIE
+46 SET FINDNAME=$$GET1^DIQ(FILENUM,FIEN,.01,"","","")
+47 SET EDTEXT="Disabled for inactive item "_FINDNAME
+48 DO BLDDLGEH(.EDITHIS,DA,EDTEXT)
End DoDot:3
+49 SET TEXT=" "_TEXT_" "_NAME_DISTXT_"IEN="_DA
+50 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXT
End DoDot:2
End DoDot:1
GOTO DIALOGX
+51 ;
+52 ;Do if MAPACT="M", only update items if file status is 6.
+53 IF FILESTAT'=6
QUIT
+54 ;I FILESTAT'=6,FILESTAT'=7 Q
+55 SET DA=0
+56 FOR
SET DA=$ORDER(^TMP($JOB,DSUB,GBL,FIEN,DA))
if DA'>0
QUIT
Begin DoDot:1
+57 SET NAME=$PIECE(^PXRMD(801.41,DA,0),U)
+58 SET TYPE=$PIECE(^PXRMD(801.41,DA,0),U,4)
+59 SET TEXT="Dialog "_$SELECT(TYPE="E":"element",TYPE="G":"group",TYPE="S":"result group",1:"item")_" "_NAME
+60 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_TEXT
+61 ;
+62 SET FIELD=0
+63 FOR
SET FIELD=$ORDER(^TMP($JOB,DSUB,GBL,FIEN,DA,FIELD))
if FIELD'>0
QUIT
Begin DoDot:2
+64 ;additional loop for additional findings
+65 IF FIELD=18
Begin DoDot:3
+66 SET AIEN=0
+67 FOR
SET AIEN=$ORDER(^TMP($JOB,DSUB,GBL,FIEN,DA,FIELD,AIEN))
if AIEN'>0
QUIT
Begin DoDot:4
+68 DO DIALUPD(FIEN,+REPA,GBL,FIELD,DA,AIEN,FILENUM,"Additional Finding item",.EDITHIS)
+69 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Additional Finding item was replaced."
End DoDot:4
End DoDot:3
QUIT
+70 ;
+71 SET FIELDNAM=$SELECT(FIELD=15:"Finding Item",FIELD=17:"Orderable Item",FIELD=119:"MH Test",1:" ")
+72 DO DIALUPD(FIEN,+REPA,GBL,FIELD,DA,0,FILENUM,FIELDNAM,.EDITHIS)
+73 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_FIELDNAM_" was replaced."
End DoDot:2
End DoDot:1
+74 ;
DIALOGX ;
+1 IF '$DATA(EDITHIS)
QUIT
+2 NEW CNT,EMSG,MESTXT
+3 SET DA=""
FOR
SET DA=$ORDER(EDITHIS(DA))
if DA'>0
QUIT
Begin DoDot:1
+4 KILL EMSG,MESTXT
+5 SET CNT=0
FOR
SET CNT=$ORDER(EDITHIS(DA,CNT))
if CNT'>0
QUIT
SET MESTXT(CNT)=EDITHIS(DA,CNT)
+6 DO UPEHIST^PXRMUTIL(801.41,DA,.MESTXT,.EMSG)
+7 IF $DATA(EMSG)
Begin DoDot:2
+8 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Edit history update failed."
+9 DO AERRMSG(.EMSG,.NL)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
+12 ;==================================================================
DIALUPD(OLDVALUE,NEWVALUE,GBL,FIELD,DIEN,FIEN,FILENUM,FIELDNAM,EDITHIST) ;
+1 NEW EMSG,FDA,FIENS,FILE,NEWNAME,OLDNAME,TEXT
+2 SET FILE=$SELECT(FIEN>0:801.4118,1:801.41)
+3 IF FILE=801.4118
SET FIELD=.01
+4 SET FIENS=$SELECT(FIEN>0:FIEN_","_DIEN_",",1:DIEN_",")
+5 SET FDA(FILE,FIENS,FIELD)=NEWVALUE_";"_GBL
+6 DO UPDATE^DIE("","FDA","","EMSG")
+7 IF $DATA(MSG)
Begin DoDot:1
+8 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Dialog update failed."
+9 DO AERRMSG(.EMSG,.NL)
End DoDot:1
QUIT
+10 SET OLDNAME=$$GET1^DIQ(FILENUM,OLDVALUE,.01,"","","")
+11 SET NEWNAME=$$GET1^DIQ(FILENUM,NEWVALUE,.01,"","","")
+12 SET TEXT=FIELDNAM_" value "_OLDNAME_" replaced by "_NEWNAME_" for data mapping"
+13 DO BLDDLGEH(.EDITHIST,DIEN,TEXT)
+14 QUIT
+15 ;
+16 ;==============================
ERROR(EVENT,NL) ;Error
+1 NEW IND
+2 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="An error occurred; error message text is -"
+3 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_^XTMP(EVENT,"ERROR")
+4 SET IND=0
+5 FOR
SET IND=$ORDER(^XTMP(EVENT,"ERROR",IND))
if IND=""
QUIT
Begin DoDot:1
+6 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_^XTMP(EVENT,"ERROR",IND)
End DoDot:1
+7 QUIT
+8 ;
+9 ;==============================
EVDRVR ;Event driver for STS events.
+1 NEW DEFL,DIAL,DLGUNMP,FIEN,FIENS,FILENUM,FILES,FINDINGS,FSTAT,GBL,MAPACT,NL
+2 NEW REPA,REPB,STATUS,TYPE,OLDSTATUS
+3 SET ZTREQ="@"
+4 KILL ^TMP($JOB,"DLG FIND"),^TMP($JOB,"FDATA"),^TMP($JOB,"PXRM DIALOGS"),^TMP("PXRMXMZ",$JOB)
+5 DO BLDDLGTM("DLG FIND")
+6 DO BLDFINDS(.FINDINGS)
+7 SET NL=1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Protocol event summary:"
+8 ;Check for error.
+9 IF $DATA(^XTMP(EVENT,"ERROR"))
DO ERROR(EVENT,.NL)
GOTO SEND
+10 SET FILENUM=0
+11 FOR
SET FILENUM=$ORDER(^XTMP(EVENT,FILENUM))
if FILENUM=""
QUIT
Begin DoDot:1
+12 ;Skip the STANDARD TERMINOLOGY VERSION FILE, it is not relevant
+13 ;for Clinical Reminders.
+14 IF FILENUM=4.009
QUIT
+15 IF '$DATA(FINDINGS(FILENUM))
QUIT
+16 SET FSTAT=$PIECE($$GETSTAT^HDISVF01(FILENUM),U,1)
+17 SET GBL=$PIECE($$GET1^DID(FILENUM,"","","GLOBAL NAME"),U,2)
+18 SET TYPE=""
+19 FOR
SET TYPE=$ORDER(^XTMP(EVENT,FILENUM,TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+20 IF TYPE="STATUS"
QUIT
+21 SET FIEN=""
+22 FOR
SET FIEN=$ORDER(^XTMP(EVENT,FILENUM,TYPE,FIEN))
if FIEN=""
QUIT
Begin DoDot:3
+23 IF FILENUM=9999999.14
IF FIEN=$$IMMNODEF^PXAPIIM()
QUIT
+24 ;Call processing routines.
+25 SET FIENS=FIEN_","
+26 SET STATUS=$$GETSTAT^XTID(FILENUM,"",FIENS)
+27 IF $PIECE(STATUS,U,3)=""
SET $PIECE(STATUS,U,3)="UNDEFINED"
+28 SET OLDSTATUS=""
+29 IF $GET(^XTMP(EVENT,FILENUM,"STATUS",FIEN))'=""
Begin DoDot:4
+30 SET OLDSTATUS=$PIECE(^XTMP(EVENT,FILENUM,"STATUS",FIEN),U,1,2)
+31 ;S OLDSTATUS=OLDSTATUS_U_$$EXTERNAL^DILFD(9999999.1499,.02,"",+OLDSTATUS)
End DoDot:4
+32 IF TYPE="NEW"
DO NEW(EVENT,FILENUM,FIEN,STATUS,.NL)
QUIT
+33 IF TYPE="BEFORE"
QUIT
+34 IF TYPE'="AFTER"
DO UNKNOWN(TYPE,.NL)
QUIT
+35 SET REPA=$GET(^XTMP(EVENT,FILENUM,"AFTER",FIEN,"INHERITS FROM"))
+36 SET REPB=$GET(^XTMP(EVENT,FILENUM,"BEFORE",FIEN,"INHERITS FROM"))
+37 ;MAP ACTION can be M (map) or U (unmap) or N (none).
+38 ;Set the map action for displaying the status.
+39 SET MAPACT=$SELECT(REPA=REPB:"N",REPA'=(FIEN_";"_FILENUM):"M",1:"U")
+40 ; if nothing was changed, don?t need to include it.
+41 IF '$DATA(^XTMP(EVENT,FILENUM,"AFTER",FIEN,0))
IF MAPACT="N"
QUIT
+42 DO STATUSTX(MAPACT,FILENUM,FIEN,REPA,REPB,OLDSTATUS,STATUS,.NL)
+43 SET DLGUNMP=$SELECT(MAPACT="U":1,1:0)
+44 ;Unless the file status is 6 do not do any automatic replacements.
+45 SET MAPACT=$SELECT(FSTAT'=6:"N",1:MAPACT)
+46 ;Process the lists, doing replacements updates etc. and generate
+47 ;a MailMan message describing what was done.
+48 DO DEFLIST^PXRMFRPT(FILENUM,GBL,FIEN,"FDATA")
+49 DO DEF(FILENUM,GBL,FIEN,REPA,MAPACT,.NL)
+50 DO TERMLIST^PXRMFRPT(FILENUM,GBL,FIEN,"FDATA")
+51 DO TERM(FILENUM,GBL,FIEN,REPA,MAPACT,.NL)
+52 DO DIALOG(FILENUM,GBL,FIEN,REPA,REPB,MAPACT,"DLG FIND",DLGUNMP,STATUS,.NL)
End DoDot:3
End DoDot:2
End DoDot:1
+53 ;
+54 ; If there is no content, don't send the message
+55 IF NL=1
QUIT
+56 ;
+57 ;Deliver the MailMan message.
SEND DO SEND^PXRMMSG("PXRMXMZ",SUBJECT,"",DUZ)
+1 KILL ^TMP($JOB,"DLG FIND"),^TMP($JOB,"FDATA"),^TMP($JOB,"PXRM DIALOGS"),^TMP("PXRMXMZ",$JOB),^XTMP(EVENT)
+2 QUIT
+3 ;
+4 ;==============================
GENTERM(FILENUM,IEN,REP,NL) ;Generate a term that contains the original
+1 ;definition finding and its replacement as mapped findings.
+2 NEW EMSG,FDA,FINDING,ROOT,TEMP,TEXT,TIEN,TIENS,TNAME,WPTMP
+3 SET TNAME=$$GENTNAME(FILENUM,IEN)
+4 SET TEMP="^PXRMD(811.5,"
+5 DO SETSTART^PXRMCOPY(TEMP)
+6 SET TIEN=$$GETFOIEN^PXRMCOPY(TEMP)
+7 SET TIENS="+"_TIEN_","
+8 SET FINDING=REP
+9 SET ROOT=$PIECE($$ROOT^DILFD(FILENUM),"^",2)
+10 SET $PIECE(FINDING,";",2)=ROOT
+11 SET FDA(811.5,TIENS,.01)=TNAME
+12 SET FDA(811.5,TIENS,.04)=DT
+13 SET FDA(811.5,TIENS,100)="L"
+14 SET FDA(811.5,TIENS,1)="WPTMP(1,1)"
+15 SET WPTMP(1,1,1)="Autogenerated during STS protocol processing."
+16 SET FDA(811.52,"+1,"_TIENS,.01)=FIEN_";"_ROOT
+17 SET FDA(811.52,"+2,"_TIENS,.01)=FINDING
+18 SET FDA(811.53,"+3,"_TIENS,.01)=$$NOW^XLFDT
+19 SET FDA(811.53,"+3,"_TIENS,1)=$GET(DUZ)
+20 SET FDA(811.53,"+3,"_TIENS,2)="WPTMP(1,1)"
+21 DO UPDATE^DIE("","FDA","","EMSG")
+22 IF $DATA(EMSG)
Begin DoDot:1
+23 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Term creation failed."
+24 DO AERRMSG(.EMSG,.NL)
End DoDot:1
QUIT 0
+25 QUIT TIEN_";"_TNAME
+26 ;
+27 ;==============================
GENTNAME(FILENUM,IEN) ;Generate a new term name to use. Create it based on
+1 ;the original definition finding.
+2 NEW ABBR,FNAME,NLEN,TEMP,TNAME,TSTAMP
+3 SET FNAME=$$GET1^DIQ(FILENUM,IEN,.01)
+4 ;DBIA #2991, #5149 for access to ^DD.
+5 SET TEMP=$ORDER(^DD(811.902,.01,"V","B",FILENUM,""))
+6 SET ABBR=$PIECE(^DD(811.902,.01,"V",TEMP,0),U,4)
+7 SET TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+8 ;Calculate the number of characters from the .01 we can use.
+9 ;AUTOGENERATED ABBR-NAME TIMESTAMP
+10 SET NLEN=48-$LENGTH(ABBR)-$LENGTH(TSTAMP)
+11 SET TNAME="AUTOGENERATED "_ABBR_"-"_$EXTRACT(FNAME,1,NLEN)_" "_TSTAMP
+12 QUIT TNAME
+13 ;
+14 ;==============================
NEW(EVENT,FILENUM,FIEN,STATUS,NL) ;New entry in file.
+1 NEW FNAME,NAME
+2 SET FNAME=$$GET1^DID(FILENUM,"","","NAME")
+3 SET NAME=$PIECE(^XTMP(EVENT,FILENUM,"NEW",FIEN,0),U,1)
+4 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+5 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="======================================================"
+6 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Added new "_FNAME_" named "_NAME_" status is "_$PIECE(STATUS,U,3)
+7 QUIT
+8 ;
+9 ;==============================
RFWT(IEN,FI,TERM,NL) ;Definition finding has a replacement; change the
+1 ;finding to a term that is mapped to the original replacement and
+2 ;its replacement.
+3 NEW EMSG,FDA,TEXT
+4 SET FDA(811.902,FI_","_IEN_",",.01)=$PIECE(TERM,";",1)_";PXRMD(811.5,"
+5 DO FILE^DIE("","FDA","EMSG")
+6 IF $DATA(MSG)
Begin DoDot:1
+7 NEW ERRMSG,IND
+8 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Error changing finding to term."
+9 DO AERRMSG(.EMSG,.NL)
End DoDot:1
+10 IF '$TEST
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Finding number "_FI_" changed to RT."_$PIECE(TERM,";",2)
+11 SET TEXT(1)="STS protocol automated update."
+12 SET TEXT(2)="Finding number "_FI_" changed to RT."_$PIECE(TERM,";",2)_"."
+13 DO UPEHIST^PXRMUTIL(811.9,IEN,.TEXT,.EMSG)
+14 IF $DATA(EMSG)
Begin DoDot:1
+15 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Edit history update failed."
+16 DO AERRMSG(.EMSG,.NL)
End DoDot:1
+17 QUIT
+18 ;
+19 ;==============================
STATUSTX(MAPACT,FILENUM,FIEN,REPA,REPB,OLDSTATUS,STATUS,NL) ;Generate the status text.
+1 NEW ABBR,FNAME,NAME,RFNAME,RFNUM,RIEN,RNAME,TEMP
+2 SET FNAME=$$GET1^DID(FILENUM,"","","NAME")
+3 SET NAME=$$GET1^DIQ(FILENUM,FIEN,.01)
+4 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+5 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="======================================================"
+6 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=FNAME_" entry "_NAME_" status "_$SELECT(OLDSTATUS'=""&(+OLDSTATUS'=+STATUS):"was changed to ",1:"is ")_$PIECE(STATUS,U,3)
+7 IF MAPACT="M"
Begin DoDot:1
+8 SET RIEN=$PIECE(REPA,";",1)
+9 SET RFNUM=$PIECE(REPA,";",2)
+10 SET RFNAME=$$GET1^DID(RFNUM,"","","NAME")
+11 SET RNAME=$$GET1^DIQ(RFNUM,RIEN,.01)
+12 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Its replacement is "_RFNAME_"; "_RNAME_"."
End DoDot:1
+13 IF MAPACT="U"
Begin DoDot:1
+14 SET RIEN=$PIECE(REPB,";",1)
+15 SET RFNUM=$PIECE(REPB,";",2)
+16 SET RFNAME=$$GET1^DID(RFNUM,"","","NAME")
+17 SET RNAME=$$GET1^DIQ(RFNUM,RIEN,.01)
+18 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" It is being unmapped; originally mapped to "_RFNAME_"; "_RNAME_"."
+19 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" This finding may need to be manually removed."
End DoDot:1
+20 QUIT
+21 ;
+22 ;==============================
TERM(FILENUM,GBL,FIEN,REP,MAPACT,NL) ;Search all reminder terms for any
+1 ;that are using this finding, defined by the global (GBL) and the
+2 ;IEN (FIEN).
+3 NEW FI,IEN,TERM
+4 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+5 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" It is used in the following terms:"
+6 IF '$DATA(^TMP($JOB,"FDATA",FILENUM,FIEN,"TERM"))
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" None"
QUIT
+7 SET IEN=0
+8 FOR
SET IEN=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,"TERM",IEN))
if IEN=""
QUIT
Begin DoDot:1
+9 SET TERM=$PIECE(^PXRMD(811.5,IEN,0),U,1)
+10 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+11 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_TERM_" IEN="_IEN
+12 SET FI=""
+13 FOR
SET FI=$ORDER(^TMP($JOB,"FDATA",FILENUM,FIEN,"TERM",IEN,FI))
if FI=""
QUIT
Begin DoDot:2
+14 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Finding number "_FI
+15 IF MAPACT="M"
DO ATFND(IEN,FI,REP,.NL)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
+18 ;==============================
UNKNOWN(TYPE,NL) ;Unknown event type.
+1 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TYPE_" is an unknown event type."
+2 QUIT
+3 ;
