LRERT1 ;DALOI/JDB - STS TEAM UTILITIES ;04/10/12 15:38
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
; Reference to LABXCPT^HDISVAP1 supported by DBIA #5026
;
; ZEXCEPT is used to identify variables which are external to a specific TAG
; used in conjunction with Eclipse M-editor.
;
Q
;
TASK(LRFN,LRIEN) ;
; Tasks the STS/HDI alert process to ensure FileMan safety.
; Expects X1 and X2 FileMan arrays from Record based xref.
; Inputs
; LRFN: File number
; LRIEN: IEN
;
;ZEXCEPT: X1,X2
;
N LRTN,LRVARS,LRX,LRVARS,LRX1,LRX2
M LRX1=X1
M LRX2=X2
S LRTN="AERT^LRERT1("_LRFN_","_LRIEN_")"
S LRVARS("LRX1(")="" ;Old values
S LRVARS("LRX2(")="" ;New values
S LRX=$$TASK^LRUTIL(LRTN,"Generate STS alert from xref",.LRVARS,1,$H,"")
Q
;
;
AERT(LRFN,LRIEN) ;
; "AERT" new style xref handler (file #61, 61.2, 62)
; FileMan safe
; New style, MUMPS Action, Activity:null, Execution:Record
; Sequence 1 = .01 Sequence 2 = SNOMED CT
;PATCH^XPDUTL/10141
; Inputs
; LRFN: File number
; LRIEN: IEN
; To be 100% FileMan safe, this process should be queued.
; If this term is already in the alert file ^XTMP("LRSCTX-STS" and the SCT code has not changed, no alert is sent.
;
;ZEXCEPT: LRX1,LRX2,ZTQUEUED,ZTREQ
;
; Not being added/changed by user so quit
Q:$D(LRFMERTS)
;
N LRERT,LRNOW,LRTXT
S LRFN=$G(LRFN),LRIEN=$G(LRIEN)
I 'LRFN!('LRIEN) Q
S LRTXT=$G(LRX2(1))
S LRNOW=$$NOW^XLFDT()
S LRERT("FILE")=LRFN
S LRERT("FIEN")=LRIEN
S LRERT("TNUM")=$$TNUM^LRERT(LRFN,LRIEN,LRNOW,3) ;3=local change
S LRERT("SCT")=$G(LRX2(2))
S LRERT("TDT")=LRNOW
S LRERT("STSEXC")=3 ;local change
S LRERT("PREV","TEXT")=$G(LRX1(1))
S LRERT("PREV","SCT")=$G(LRX1(2))
D ;
. N X,X1,X2,Y,DA,DIE,DIC,DIR,D0,DIU,LRX
. S LRX=$$OK2LOG^LRERT(.LRTXT,.LRERT,"LRSCTX-ERT")
. I 'LRX I $P(LRX,"^",2)'=2 Q ;continue if SCT changed
. S LRX=$$LOGIT^LRERT(.LRTXT,.LRERT,"LRSCTX-STS")
. S LRX=$$NOTIFY(.LRTXT,.LRERT)
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
;
NOTIFY(LRTXT,LRERT) ;
;
; Private helper method
; FileMan safe
; Handles STS/Local notification for "local edit" new terms.
; If a new term has been added and not in ^XTMP:
; 1) alert STS 2) Add entry to ^XTMP 3) Email LAB MAPPING group
; Inputs
; LRTXT: Term
; LRERT:<byref>
; Outputs
; String indicating success or error: Status^Error code^text
; Status: 1=success 0=error
; ie "0^1^Term is null" "0^4^"STS & MailMan error"
;
;ZEXCEPT: LRFIEN,LRFILE,LRSCT,NODE
;
N DATA,DATA2,LRLCK,STOP,STR,STR2,NOTIFY,SITE
N TNUM,TMPNM,TEXT,I,II,X,Y,LRHDI,LRHDIERR,TSTAT,TDT
N DA,DR,DIE,DIR,DIC,X,X1,X2,Y,DIERR
S LRTXT=$G(LRTXT)
I $TR(LRTXT," ","")="" Q "0^1^Term is null"
S LRFILE=$G(LRERT("FILE")),LRFIEN=$G(LRERT("FIEN")),LRSCT=$G(LRERT("SCT"))
S NOTIFY=1 ;status of this process
S TMPNM="LRSCTX-STS"
S TDT=$G(LRERT("TDT"))
I TDT="" S TDT=$$NOW^XLFDT() S LRERT("TDT")=TDT
; TSTAT 0=New record 1=Text changed 2=Text same
S TSTAT=$G(LRERT("PREV","TEXT"))'=""
I TSTAT I $G(LRERT("PREV","TEXT"))=LRTXT S TSTAT=2
S TNUM=$G(LRERT("TNUM"))
;
; STS Reporting Array
K DATA,LRHDI
S LRHDI(3,1)=TNUM_"^"_TDT
S X=$$BLDERTX^LRERT(LRFILE,LRFIEN,"|",.DATA,2,"S") ;new data
M LRHDI(3,1,"SA")=DATA
;
; build a pseudo "before" data
I TSTAT D
. M LRHDI(3,1,"SB")=DATA
. S LRHDI(3,1,"SB",2)=$G(LRERT("PREV","TEXT"))
. S LRHDI(3,1,"SB",5)=$G(LRERT("PREV","SCT"))
. S LRHDI(3,1,"SB",6)="" ;SCT text
. S X=$G(LRERT("PREV","SCT"))
. I X'="" D ;
. . K DATA
. . S X=$$CODE^LRSCT(X,"SCT","","DATA")
. . S LRHDI(3,1,"SB",6)=$G(DATA("F"))
;
K DATA
;
S X=$S(TSTAT:"modified in",1:"added to")
S LRHDI(3,1,"TXT")="Term "_X_" file #"_LRFILE_" (entry #"_LRFIEN_")"
;
D LABXCPT^HDISVAP1("LRHDI")
; check LRHDI("ERROR") and add error to local email
K LRHDIERR
M LRHDIERR("ERROR")=LRHDI("ERROR")
K LRHDI
I $D(LRHDIERR) S NOTIFY="0^2^HDI error"
;
; Update ^XTMP
S LRERT("HDIERR")=$S($D(LRHDIERR):1,1:0)
S X=$$LOGIT^LRERT(LRTXT,.LRERT)
;
; Notify local staff of event (G.LAB MAPPING)
N DA,DIE,DIC,DIR,D0,DIFROM,LRMTXT,X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG
;
S XMSUB="Local modification to file (#"_LRFILE_":"_LRFIEN_")"
S X=$S(TSTAT:"modified in",1:"added to")
S LRMTXT(1,0)="Term "_X_" file #"_LRFILE_" (entry #"_LRFIEN_")"
S LRMTXT(2,0)=" "
I TSTAT=1 S LRMTXT(3,0)="Previous Text: "_$G(LRERT("PREV","TEXT"))
S LRMTXT(4,0)=$S('TSTAT:"New Text",1:"Term")_": "_LRTXT
S X=$S(TSTAT:"Modified",1:"Added")
S LRMTXT(5,0)=X_" by: "_$$UP^XLFSTR($$NAME^XUSER(DUZ,"F"))
S LRMTXT(6,0)=" "
S LRMTXT(7,0)="Tracking information below:"
S LRMTXT(8,0)="Transaction date: "_$$FMTE^XLFDT(TDT)
S LRMTXT(9,0)="Transaction number: "_TNUM
S LRMTXT(10,0)="SNOMED CT code: "_$S(LRSCT'="":LRSCT,1:"n/a")
I $G(LRERT("PREV","SCT"))'="" D ;
. S X=LRERT("PREV","SCT")
. I X'=$G(LRERT("SCT")) S LRMTXT(11,0)="Previous SNOMED CT code: "_X
;
I $D(LRHDIERR) D ;
. S LRMTXT(20,0)=" "
. S LRMTXT(21,0)="An error occurred when notifying STS:"
. S NODE="LRHDIERR(0)"
. S I=$O(LRMTXT("A"),-1)
. F S NODE=$Q(@NODE) Q:NODE="" S I=I+1,LRMTXT(I,0)=" "_NODE
;
I $$GOTLOCAL^XMXAPIG("LAB MAPPING") S XMY("I:G.LAB MAPPING")=""
E S XMY("I:G.LMI")=""
;
S XMTEXT="LRMTXT("
D ^XMD
I $D(XMMG)!'$G(XMZ) D ;
. I $D(LRHDIERR) S NOTIFY="0^4^STS & Mailman error" Q
. S NOTIFY="0^3^MailMan error"
;
; Update and store this transaction info in the target file.
D SCTUPD
;
Q NOTIFY
;
;
SCTUPD ; Update SCT STATUS DATE multiple
;
;ZEXCEPT: LRDUZ,LRFILE,LRFIEN,TDT,TNUM
;.
N LRERR,LRFDA,LRFLD,LRSUBFILE,LRSTATUS
;
S LRSUBFILE=$S(LRFILE=61:61.023,LRFILE=61.2:61.223,LRFILE=62:62.023,1:"")
I LRSUBFILE="" Q
;
; Store date/time, user and new status
S LRFDA(2,LRSUBFILE,"+2,"_LRFIEN_",",.01)=TDT
S LRSTATUS=$$GET1^DIQ(LRFILE,LRFIEN_",",21,"I")
S LRFDA(2,LRSUBFILE,"+2,"_LRFIEN_",",1)=$S(LRSTATUS'="":LRSTATUS,1:"R")
S LRFDA(2,LRSUBFILE,"+2,"_LRFIEN_",",3)=$S($G(LRDUZ):LRDUZ,1:DUZ)
;
; Store transaction number
S LRFDA(2,LRSUBFILE,"+2,"_LRFIEN_",",2)=TNUM
;
D UPDATE^DIE("","LRFDA(2)","LRFIEN","LRERR(2)")
;
; Store execption text in WP field
D WP^DIE(LRSUBFILE,LRFIEN(2)_","_LRFIEN_",",4,"A","LRMTXT","LRERR(3)")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRERT1 6340 printed Sep 23, 2025@19:50:19 Page 2
LRERT1 ;DALOI/JDB - STS TEAM UTILITIES ;04/10/12 15:38
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 ; Reference to LABXCPT^HDISVAP1 supported by DBIA #5026
+4 ;
+5 ; ZEXCEPT is used to identify variables which are external to a specific TAG
+6 ; used in conjunction with Eclipse M-editor.
+7 ;
+8 QUIT
+9 ;
TASK(LRFN,LRIEN) ;
+1 ; Tasks the STS/HDI alert process to ensure FileMan safety.
+2 ; Expects X1 and X2 FileMan arrays from Record based xref.
+3 ; Inputs
+4 ; LRFN: File number
+5 ; LRIEN: IEN
+6 ;
+7 ;ZEXCEPT: X1,X2
+8 ;
+9 NEW LRTN,LRVARS,LRX,LRVARS,LRX1,LRX2
+10 MERGE LRX1=X1
+11 MERGE LRX2=X2
+12 SET LRTN="AERT^LRERT1("_LRFN_","_LRIEN_")"
+13 ;Old values
SET LRVARS("LRX1(")=""
+14 ;New values
SET LRVARS("LRX2(")=""
+15 SET LRX=$$TASK^LRUTIL(LRTN,"Generate STS alert from xref",.LRVARS,1,$HOROLOG,"")
+16 QUIT
+17 ;
+18 ;
AERT(LRFN,LRIEN) ;
+1 ; "AERT" new style xref handler (file #61, 61.2, 62)
+2 ; FileMan safe
+3 ; New style, MUMPS Action, Activity:null, Execution:Record
+4 ; Sequence 1 = .01 Sequence 2 = SNOMED CT
+5 ;PATCH^XPDUTL/10141
+6 ; Inputs
+7 ; LRFN: File number
+8 ; LRIEN: IEN
+9 ; To be 100% FileMan safe, this process should be queued.
+10 ; If this term is already in the alert file ^XTMP("LRSCTX-STS" and the SCT code has not changed, no alert is sent.
+11 ;
+12 ;ZEXCEPT: LRX1,LRX2,ZTQUEUED,ZTREQ
+13 ;
+14 ; Not being added/changed by user so quit
+15 if $DATA(LRFMERTS)
QUIT
+16 ;
+17 NEW LRERT,LRNOW,LRTXT
+18 SET LRFN=$GET(LRFN)
SET LRIEN=$GET(LRIEN)
+19 IF 'LRFN!('LRIEN)
QUIT
+20 SET LRTXT=$GET(LRX2(1))
+21 SET LRNOW=$$NOW^XLFDT()
+22 SET LRERT("FILE")=LRFN
+23 SET LRERT("FIEN")=LRIEN
+24 ;3=local change
SET LRERT("TNUM")=$$TNUM^LRERT(LRFN,LRIEN,LRNOW,3)
+25 SET LRERT("SCT")=$GET(LRX2(2))
+26 SET LRERT("TDT")=LRNOW
+27 ;local change
SET LRERT("STSEXC")=3
+28 SET LRERT("PREV","TEXT")=$GET(LRX1(1))
+29 SET LRERT("PREV","SCT")=$GET(LRX1(2))
+30 ;
Begin DoDot:1
+31 NEW X,X1,X2,Y,DA,DIE,DIC,DIR,D0,DIU,LRX
+32 SET LRX=$$OK2LOG^LRERT(.LRTXT,.LRERT,"LRSCTX-ERT")
+33 ;continue if SCT changed
IF 'LRX
IF $PIECE(LRX,"^",2)'=2
QUIT
+34 SET LRX=$$LOGIT^LRERT(.LRTXT,.LRERT,"LRSCTX-STS")
+35 SET LRX=$$NOTIFY(.LRTXT,.LRERT)
End DoDot:1
+36 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+37 QUIT
+38 ;
+39 ;
NOTIFY(LRTXT,LRERT) ;
+1 ;
+2 ; Private helper method
+3 ; FileMan safe
+4 ; Handles STS/Local notification for "local edit" new terms.
+5 ; If a new term has been added and not in ^XTMP:
+6 ; 1) alert STS 2) Add entry to ^XTMP 3) Email LAB MAPPING group
+7 ; Inputs
+8 ; LRTXT: Term
+9 ; LRERT:<byref>
+10 ; Outputs
+11 ; String indicating success or error: Status^Error code^text
+12 ; Status: 1=success 0=error
+13 ; ie "0^1^Term is null" "0^4^"STS & MailMan error"
+14 ;
+15 ;ZEXCEPT: LRFIEN,LRFILE,LRSCT,NODE
+16 ;
+17 NEW DATA,DATA2,LRLCK,STOP,STR,STR2,NOTIFY,SITE
+18 NEW TNUM,TMPNM,TEXT,I,II,X,Y,LRHDI,LRHDIERR,TSTAT,TDT
+19 NEW DA,DR,DIE,DIR,DIC,X,X1,X2,Y,DIERR
+20 SET LRTXT=$GET(LRTXT)
+21 IF $TRANSLATE(LRTXT," ","")=""
QUIT "0^1^Term is null"
+22 SET LRFILE=$GET(LRERT("FILE"))
SET LRFIEN=$GET(LRERT("FIEN"))
SET LRSCT=$GET(LRERT("SCT"))
+23 ;status of this process
SET NOTIFY=1
+24 SET TMPNM="LRSCTX-STS"
+25 SET TDT=$GET(LRERT("TDT"))
+26 IF TDT=""
SET TDT=$$NOW^XLFDT()
SET LRERT("TDT")=TDT
+27 ; TSTAT 0=New record 1=Text changed 2=Text same
+28 SET TSTAT=$GET(LRERT("PREV","TEXT"))'=""
+29 IF TSTAT
IF $GET(LRERT("PREV","TEXT"))=LRTXT
SET TSTAT=2
+30 SET TNUM=$GET(LRERT("TNUM"))
+31 ;
+32 ; STS Reporting Array
+33 KILL DATA,LRHDI
+34 SET LRHDI(3,1)=TNUM_"^"_TDT
+35 ;new data
SET X=$$BLDERTX^LRERT(LRFILE,LRFIEN,"|",.DATA,2,"S")
+36 MERGE LRHDI(3,1,"SA")=DATA
+37 ;
+38 ; build a pseudo "before" data
+39 IF TSTAT
Begin DoDot:1
+40 MERGE LRHDI(3,1,"SB")=DATA
+41 SET LRHDI(3,1,"SB",2)=$GET(LRERT("PREV","TEXT"))
+42 SET LRHDI(3,1,"SB",5)=$GET(LRERT("PREV","SCT"))
+43 ;SCT text
SET LRHDI(3,1,"SB",6)=""
+44 SET X=$GET(LRERT("PREV","SCT"))
+45 ;
IF X'=""
Begin DoDot:2
+46 KILL DATA
+47 SET X=$$CODE^LRSCT(X,"SCT","","DATA")
+48 SET LRHDI(3,1,"SB",6)=$GET(DATA("F"))
End DoDot:2
End DoDot:1
+49 ;
+50 KILL DATA
+51 ;
+52 SET X=$SELECT(TSTAT:"modified in",1:"added to")
+53 SET LRHDI(3,1,"TXT")="Term "_X_" file #"_LRFILE_" (entry #"_LRFIEN_")"
+54 ;
+55 DO LABXCPT^HDISVAP1("LRHDI")
+56 ; check LRHDI("ERROR") and add error to local email
+57 KILL LRHDIERR
+58 MERGE LRHDIERR("ERROR")=LRHDI("ERROR")
+59 KILL LRHDI
+60 IF $DATA(LRHDIERR)
SET NOTIFY="0^2^HDI error"
+61 ;
+62 ; Update ^XTMP
+63 SET LRERT("HDIERR")=$SELECT($DATA(LRHDIERR):1,1:0)
+64 SET X=$$LOGIT^LRERT(LRTXT,.LRERT)
+65 ;
+66 ; Notify local staff of event (G.LAB MAPPING)
+67 NEW DA,DIE,DIC,DIR,D0,DIFROM,LRMTXT,X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG
+68 ;
+69 SET XMSUB="Local modification to file (#"_LRFILE_":"_LRFIEN_")"
+70 SET X=$SELECT(TSTAT:"modified in",1:"added to")
+71 SET LRMTXT(1,0)="Term "_X_" file #"_LRFILE_" (entry #"_LRFIEN_")"
+72 SET LRMTXT(2,0)=" "
+73 IF TSTAT=1
SET LRMTXT(3,0)="Previous Text: "_$GET(LRERT("PREV","TEXT"))
+74 SET LRMTXT(4,0)=$SELECT('TSTAT:"New Text",1:"Term")_": "_LRTXT
+75 SET X=$SELECT(TSTAT:"Modified",1:"Added")
+76 SET LRMTXT(5,0)=X_" by: "_$$UP^XLFSTR($$NAME^XUSER(DUZ,"F"))
+77 SET LRMTXT(6,0)=" "
+78 SET LRMTXT(7,0)="Tracking information below:"
+79 SET LRMTXT(8,0)="Transaction date: "_$$FMTE^XLFDT(TDT)
+80 SET LRMTXT(9,0)="Transaction number: "_TNUM
+81 SET LRMTXT(10,0)="SNOMED CT code: "_$SELECT(LRSCT'="":LRSCT,1:"n/a")
+82 ;
IF $GET(LRERT("PREV","SCT"))'=""
Begin DoDot:1
+83 SET X=LRERT("PREV","SCT")
+84 IF X'=$GET(LRERT("SCT"))
SET LRMTXT(11,0)="Previous SNOMED CT code: "_X
End DoDot:1
+85 ;
+86 ;
IF $DATA(LRHDIERR)
Begin DoDot:1
+87 SET LRMTXT(20,0)=" "
+88 SET LRMTXT(21,0)="An error occurred when notifying STS:"
+89 SET NODE="LRHDIERR(0)"
+90 SET I=$ORDER(LRMTXT("A"),-1)
+91 FOR
SET NODE=$QUERY(@NODE)
if NODE=""
QUIT
SET I=I+1
SET LRMTXT(I,0)=" "_NODE
End DoDot:1
+92 ;
+93 IF $$GOTLOCAL^XMXAPIG("LAB MAPPING")
SET XMY("I:G.LAB MAPPING")=""
+94 IF '$TEST
SET XMY("I:G.LMI")=""
+95 ;
+96 SET XMTEXT="LRMTXT("
+97 DO ^XMD
+98 ;
IF $DATA(XMMG)!'$GET(XMZ)
Begin DoDot:1
+99 IF $DATA(LRHDIERR)
SET NOTIFY="0^4^STS & Mailman error"
QUIT
+100 SET NOTIFY="0^3^MailMan error"
End DoDot:1
+101 ;
+102 ; Update and store this transaction info in the target file.
+103 DO SCTUPD
+104 ;
+105 QUIT NOTIFY
+106 ;
+107 ;
SCTUPD ; Update SCT STATUS DATE multiple
+1 ;
+2 ;ZEXCEPT: LRDUZ,LRFILE,LRFIEN,TDT,TNUM
+3 ;.
+4 NEW LRERR,LRFDA,LRFLD,LRSUBFILE,LRSTATUS
+5 ;
+6 SET LRSUBFILE=$SELECT(LRFILE=61:61.023,LRFILE=61.2:61.223,LRFILE=62:62.023,1:"")
+7 IF LRSUBFILE=""
QUIT
+8 ;
+9 ; Store date/time, user and new status
+10 SET LRFDA(2,LRSUBFILE,"+2,"_LRFIEN_",",.01)=TDT
+11 SET LRSTATUS=$$GET1^DIQ(LRFILE,LRFIEN_",",21,"I")
+12 SET LRFDA(2,LRSUBFILE,"+2,"_LRFIEN_",",1)=$SELECT(LRSTATUS'="":LRSTATUS,1:"R")
+13 SET LRFDA(2,LRSUBFILE,"+2,"_LRFIEN_",",3)=$SELECT($GET(LRDUZ):LRDUZ,1:DUZ)
+14 ;
+15 ; Store transaction number
+16 SET LRFDA(2,LRSUBFILE,"+2,"_LRFIEN_",",2)=TNUM
+17 ;
+18 DO UPDATE^DIE("","LRFDA(2)","LRFIEN","LRERR(2)")
+19 ;
+20 ; Store execption text in WP field
+21 DO WP^DIE(LRSUBFILE,LRFIEN(2)_","_LRFIEN_",",4,"A","LRMTXT","LRERR(3)")
+22 ;
+23 QUIT
