LRSCTF1 ;DALOI/JDB - SCT POPULATION/ERT ALERT ;01/16/13 10:02
;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
;
; Reference to LABXCPT^HDISVAP1 supported by DBIA #5026
Q
;
;
NOTIFY(LRTXT,LRFILE,LRFIEN,LRSCT,EXCDATA,LRDUPCHK) ;
;LABXCPT^HDISVAP1/5026
; Private helper method
; Handles ERT/Local notification for "Load Exception" errors.
; If an SCT load exception occurs and not in ^XTMP alert ERT.
; Inputs
; LRTXT: Code text
; LRFILE: Target file #
; LRFIEN: Target file # IEN
; LRSCT: SCT Code <opt>
; EXCDATA:<byref>
; LRDUPCHK: Check for duplicate alert <opt>
; Outputs
; String indicating success or error.
; On success returns the new ^XTMP IEN
; On failure returns "0^num^msg"
; ie "0^1^Term is null"
; Returns transaction # in EXCDATA("TNUM")
;
N DATA,LRIN,NOW,STR,STR2,NOTIFY,SITE
N TNUM,TMPNM,TEXT,I,II,X,Y,LRHDI,LRHDIERR
S LRTXT=$G(LRTXT)
I $TR(LRTXT," ","")="" Q "0^1^Term is null"
S LRFILE=$G(LRFILE),LRFIEN=$G(LRFIEN),LRSCT=$G(LRSCT),LRDUPCHK=$G(LRDUPCHK,1)
S NOTIFY=1 ;status of this process
S TMPNM="LRSCTF-STS"
S NOW=$$NOW^XLFDT()
S TEXT=$$TRIM^XLFSTR(LRTXT),TEXT=$$UP^XLFSTR(TEXT)
S STR=$E(TEXT,1,200) ;some terms can be long and wont fit in a node
; check if this term has been sent already.
K LRIN
S LRIN("FILE")=LRFILE,LRIN("SCT")=LRSCT,LRIN("PREV","SCT")=$$GET1^DIQ(LRFILE,LRFIEN_",",20)
S X=$$OK2LOG^LRERT(.LRTXT,.LRIN,TMPNM)
I $G(LRDUPCHK),'X,$P(X,"^",2)'=2 Q "0^2^Notification already sent."
K DATA,LRHDI,TEXT,STR
;
S TNUM=$$TNUM^LRERT(LRFILE,LRFIEN,NOW,1)
S EXCDATA("TNUM")=TNUM
S LRHDI(1,1)=TNUM_"^"_NOW
S X=$$BLDERTX^LRERT(LRFILE,LRFIEN,"|",.DATA,2,"S")
S I=0
F S I=$O(DATA(I)) Q:'I S LRHDI(1,1,"SA",I)=DATA(I)
; see patch HDI*1.0*7 for array details
F I=7:1:11 I $G(EXCDATA("SA",I))'="" S LRHDI(1,1,"SA",I)=EXCDATA("SA",I)
;
S LRHDI(1,1,"RD",5)=1
F I=1:1:6 I $G(EXCDATA("RD",I))'="" S LRHDI(1,1,"RD",I)=EXCDATA("RD",I)
;
S LRHDI(1,1,"TXT")=$G(EXCDATA("TXT"))
;
D LABXCPT^HDISVAP1("LRHDI")
; check LRHDI("ERROR")
K LRHDIERR
M LRHDIERR("ERROR")=LRHDI("ERROR")
K LRHDI
;
; Update ^XTMP
K LRIN
S LRIN("TNUM")=TNUM ;trans #
S LRIN("TDT")=NOW ;trans date/time
S LRIN("FILE")=LRFILE ; targ file
S LRIN("FIEN")=LRFIEN ;targ file IEN
S LRIN("SCT")=LRSCT ;SCT code
S LRIN("STSEXC")=1 ;STS exception type
S LRIN("HDIERR")=$S($D(LRHDIERR):1,1:0) ;STS error flag (0 or 1)
S LRIN("PREV","SCT")=""
S LRIN("PREV","TEXT")=""
S X=$$LOGIT^LRERT(.LRTXT,.LRIN,TMPNM)
I X S EXCDATA("IEN")=X
I 'X D ;
. S Y=$P(X,"^",2)
. S Y=Y+10 ;new error code group
. S NOTIFY="0^"_Y_"^$$LOGIT failed: "_$P(X,"^",3)
I $G(LRHDIERR("ERROR"))'="" S NOTIFY="0^5^LABXCPT failed: "_LRHDIERR("ERROR")
Q NOTIFY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSCTF1 2797 printed Apr 09, 2024@21:17:15 Page 2
LRSCTF1 ;DALOI/JDB - SCT POPULATION/ERT ALERT ;01/16/13 10:02
+1 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
+2 ;
+3 ; Reference to LABXCPT^HDISVAP1 supported by DBIA #5026
+4 QUIT
+5 ;
+6 ;
NOTIFY(LRTXT,LRFILE,LRFIEN,LRSCT,EXCDATA,LRDUPCHK) ;
+1 ;LABXCPT^HDISVAP1/5026
+2 ; Private helper method
+3 ; Handles ERT/Local notification for "Load Exception" errors.
+4 ; If an SCT load exception occurs and not in ^XTMP alert ERT.
+5 ; Inputs
+6 ; LRTXT: Code text
+7 ; LRFILE: Target file #
+8 ; LRFIEN: Target file # IEN
+9 ; LRSCT: SCT Code <opt>
+10 ; EXCDATA:<byref>
+11 ; LRDUPCHK: Check for duplicate alert <opt>
+12 ; Outputs
+13 ; String indicating success or error.
+14 ; On success returns the new ^XTMP IEN
+15 ; On failure returns "0^num^msg"
+16 ; ie "0^1^Term is null"
+17 ; Returns transaction # in EXCDATA("TNUM")
+18 ;
+19 NEW DATA,LRIN,NOW,STR,STR2,NOTIFY,SITE
+20 NEW TNUM,TMPNM,TEXT,I,II,X,Y,LRHDI,LRHDIERR
+21 SET LRTXT=$GET(LRTXT)
+22 IF $TRANSLATE(LRTXT," ","")=""
QUIT "0^1^Term is null"
+23 SET LRFILE=$GET(LRFILE)
SET LRFIEN=$GET(LRFIEN)
SET LRSCT=$GET(LRSCT)
SET LRDUPCHK=$GET(LRDUPCHK,1)
+24 ;status of this process
SET NOTIFY=1
+25 SET TMPNM="LRSCTF-STS"
+26 SET NOW=$$NOW^XLFDT()
+27 SET TEXT=$$TRIM^XLFSTR(LRTXT)
SET TEXT=$$UP^XLFSTR(TEXT)
+28 ;some terms can be long and wont fit in a node
SET STR=$EXTRACT(TEXT,1,200)
+29 ; check if this term has been sent already.
+30 KILL LRIN
+31 SET LRIN("FILE")=LRFILE
SET LRIN("SCT")=LRSCT
SET LRIN("PREV","SCT")=$$GET1^DIQ(LRFILE,LRFIEN_",",20)
+32 SET X=$$OK2LOG^LRERT(.LRTXT,.LRIN,TMPNM)
+33 IF $GET(LRDUPCHK)
IF 'X
IF $PIECE(X,"^",2)'=2
QUIT "0^2^Notification already sent."
+34 KILL DATA,LRHDI,TEXT,STR
+35 ;
+36 SET TNUM=$$TNUM^LRERT(LRFILE,LRFIEN,NOW,1)
+37 SET EXCDATA("TNUM")=TNUM
+38 SET LRHDI(1,1)=TNUM_"^"_NOW
+39 SET X=$$BLDERTX^LRERT(LRFILE,LRFIEN,"|",.DATA,2,"S")
+40 SET I=0
+41 FOR
SET I=$ORDER(DATA(I))
if 'I
QUIT
SET LRHDI(1,1,"SA",I)=DATA(I)
+42 ; see patch HDI*1.0*7 for array details
+43 FOR I=7:1:11
IF $GET(EXCDATA("SA",I))'=""
SET LRHDI(1,1,"SA",I)=EXCDATA("SA",I)
+44 ;
+45 SET LRHDI(1,1,"RD",5)=1
+46 FOR I=1:1:6
IF $GET(EXCDATA("RD",I))'=""
SET LRHDI(1,1,"RD",I)=EXCDATA("RD",I)
+47 ;
+48 SET LRHDI(1,1,"TXT")=$GET(EXCDATA("TXT"))
+49 ;
+50 DO LABXCPT^HDISVAP1("LRHDI")
+51 ; check LRHDI("ERROR")
+52 KILL LRHDIERR
+53 MERGE LRHDIERR("ERROR")=LRHDI("ERROR")
+54 KILL LRHDI
+55 ;
+56 ; Update ^XTMP
+57 KILL LRIN
+58 ;trans #
SET LRIN("TNUM")=TNUM
+59 ;trans date/time
SET LRIN("TDT")=NOW
+60 ; targ file
SET LRIN("FILE")=LRFILE
+61 ;targ file IEN
SET LRIN("FIEN")=LRFIEN
+62 ;SCT code
SET LRIN("SCT")=LRSCT
+63 ;STS exception type
SET LRIN("STSEXC")=1
+64 ;STS error flag (0 or 1)
SET LRIN("HDIERR")=$SELECT($DATA(LRHDIERR):1,1:0)
+65 SET LRIN("PREV","SCT")=""
+66 SET LRIN("PREV","TEXT")=""
+67 SET X=$$LOGIT^LRERT(.LRTXT,.LRIN,TMPNM)
+68 IF X
SET EXCDATA("IEN")=X
+69 ;
IF 'X
Begin DoDot:1
+70 SET Y=$PIECE(X,"^",2)
+71 ;new error code group
SET Y=Y+10
+72 SET NOTIFY="0^"_Y_"^$$LOGIT failed: "_$PIECE(X,"^",3)
End DoDot:1
+73 IF $GET(LRHDIERR("ERROR"))'=""
SET NOTIFY="0^5^LABXCPT failed: "_LRHDIERR("ERROR")
+74 QUIT NOTIFY
