ROR10 ;HCIOFO/SG - NIGHTLY TASK UTILITIES ; 11/29/05 4:21pm
;;1.5;CLINICAL CASE REGISTRIES;**18**;Feb 17, 2006;Build 25
;
;******************************************************************************
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*18 APR 2012 C RAY Replaces list in TASK PARAMETERS with
; list of all initialized registries
;******************************************************************************
Q
;
;***** DISPLAYS THE ALERT ABOUT PROBLEMATIC HL7 MESSAGES
ALERT ;
Q:$G(XQADATA)=""
N I,PARAMS,RORINFO,TMP
;--- Get and prepare the parameters
S PARAMS("REGISTRY")=$P(XQADATA,"^")
S PARAMS("NOR")=$P(XQADATA,"^",2)
;--- Load and format the text
D BLD^DIALOG(7980000.027,.PARAMS,,"RORINFO","S")
;--- Display the text
S I="" W !!
F S I=$O(RORINFO(I)) Q:I="" W RORINFO(I),!
Q
;
;***** CHECKS THE STATUS OF LAST HL7 MESSAGE(S)
;
; .REGLST Reference to a local array containing registry
; names as subscripts and (optionally) registry
; IENs as values.
;
; Return values:
; <0 Error code
; 0 Ok
;
CHECKMSG(REGLST) ;
N RORLBLST ; List of latest batch HL7 messages (see ^ROR11)
;
N HDTIEN,IENS,IM,LBCID,MSGDT,MSGSTC,RC,REGIEN,REGNAME,RORBUF,RORFDA,RORMSG,TMP
S RC=0
;
;=== Compile the list of latest batch HL7 messages
S REGNAME=""
F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
. ;--- Get the registry IEN
. S REGIEN=+$G(REGLST(REGNAME))
. I REGIEN'>0 D I REGIEN'>0 S RC=+REGIEN Q
. . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
. S $P(REGLST(REGNAME),U)=REGIEN
. ;--- Get the list of batch HL7 message IDs
. K RORBUF,RORMSG
. S IENS=","_REGIEN_","
. D LIST^DIC(798.122,IENS,"@;.01;.02;.03I",,,,,"B",,,"RORBUF","RORMSG")
. I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.122,IENS) Q
. ;--- Update the list of latest HL7 batch messages
. S IM=""
. F S IM=$O(RORBUF("DILIST","ID",IM)) Q:IM="" D
. . S LBCID=RORBUF("DILIST","ID",IM,.01)
. . S IENS=RORBUF("DILIST",2,IM)_","_REGIEN_","
. . S MSGDT=$G(RORBUF("DILIST","ID",IM,.03))
. . D ADDMSG^ROR11(LBCID,IENS,$G(RORBUF("DILIST","ID",IM,.02)),MSGDT)
Q:RC<0 RC
;
;=== Analyze the list of messages
S LBCID=0
F S LBCID=$O(RORLBLST(LBCID)) Q:LBCID'>0 D Q:RC<0
. S MSGSTC=+RORLBLST(LBCID,"MS")
. S MSGDT=RORLBLST(LBCID,"DT")
. ;--- If the message does not exist (usually, it should), remove
. ; the reference(s) but do not update the patients' extraction
. ;--- dates. Data will be re-extracted and resent (just in case).
. I 'MSGSTC D Q
. . D DELMSG^ROR11(LBCID,.RORFDA)
. . D ERROR^RORERR(-49,,,,LBCID)
. ;--- Unfortunately, the 'successfully completed' status (3) is
. ; returned for cancelled messages as well (and possibly in
. ; some other situations). Update the patients' extraction
. ; dates only if there is no error message in the status
. ;--- string. Then remove the message reference(s).
. I MSGSTC=3 D Q
. . S TMP=$P(RORLBLST(LBCID,"MS"),U,3)
. . S:TMP="" TMP=$$UPDTRR^ROR11($P(RORLBLST(LBCID),U),MSGDT)
. . D DELMSG^ROR11(LBCID,.RORFDA)
. ;--- If the message is being processed/transmitted,
. ;--- then keep the reference(s) in the list.
. I (MSGSTC=1.5)!(MSGSTC=1.7) D Q
. . D ERROR^RORERR(-73,,,,LBCID)
. ;--- Otherwise (the message has not been sent), keep the
. ;--- reference(s) and requeue the message (just in case).
. S TMP=+$$MSGACT^HLUTIL(LBCID,2)
. D ERROR^RORERR($S(TMP:-93,1:-92),,,,LBCID)
Q:RC<0 RC
;
S REGNAME=""
F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D
. ;--- Get the registry IEN
. S REGIEN=+$G(REGLST(REGNAME)) Q:REGIEN'>0
. S IENS=REGIEN_","
. ;--- Check if all registry messages have been sent
. I $D(RORLBLST("RM",REGIEN))<10 D:$D(RORLBLST("RM",REGIEN)) Q
. . K RORLBLST("RM",REGIEN)
. . ;--- Clear the HL7 ATTEMPT COUNTER field
. . S RORFDA(798.1,IENS,19.3)="@"
. . ;--- Check for an automatic backpull definition
. . S HDTIEN=$$GET1^DIQ(798.1,IENS,21.01,"I",,"RORMSG")
. . I $G(DIERR) D DBS^RORERR("RORMSG",-9,,,798.1,IENS) Q
. . D:HDTIEN>0
. . . ;--- Reset the automatic backpull mode
. . . S RORFDA(798.1,IENS,21.01)="@"
. . . ;--- Complete the automatic backpull
. . . S TMP=$$COMPLETE^RORHDT06(HDTIEN,REGNAME)
. ;--- Increment the HL7 ATTEMPT COUNTER for registries with unsent
. ;--- message(s) and exclude those registries from data extraction.
. S TMP=$$GET1^DIQ(798.1,IENS,19.3,,,"RORMSG")
. D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,798.1,IENS)
. S RORFDA(798.1,IENS,19.3)=TMP+1
. K REGLST(REGNAME)
;
;=== Update the registry parameters if necessary
D:$D(RORFDA)>1
. D FILE^DIE(,"RORFDA","RORMSG")
. D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,798.1)
;
;=== Notify the AAC and local coordinators if necessary
D:$D(RORLBLST("RM"))>1 NOTIFY^ROR11()
;
;=== Success
Q 0
;
;***** PROCESSES THE TASK PARAMETERS
;
; .REGLST Reference to a local variable where the list of
; registry names is returned to
;
; Return values:
; <0 Error code
; 0 Ok
;
TASKPRMS(REGLST) ;
N %DT,DTOUT,INFO,REGNAME,TMP,X,Y
;--- Log the task parameters
D TP(.INFO,"RORFLSET")
D TP(.INFO,"RORFLCLR")
D TP(.INFO,"RORMNTSK")
D TP(.INFO,"RORSUSP")
D LOG^RORLOG(,"Task Parameters",,.INFO)
;--- Maximum number of subtasks
S RORMNTSK=$S(RORMNTSK'="":$TR(RORMNTSK,"-","^"),1:"2^3^AUTO")
;--- Suspension parameters
D:RORSUSP'=""
. S TMP=RORSUSP,RORSUSP=""
. F I=1,2 D S:$G(Y)>0 $P(RORSUSP,"^",I)=Y#1
. . S X=$P(TMP,"-",I),%DT="R" D ^%DT
S RC=$$REGSEL^RORUTL01("I") ;only initialized registries
Q:RC<0 RC
;--- Flags
S RORFLCLR=$$UP^XLFSTR(RORFLCLR)
S RORFLSET=$$UP^XLFSTR(RORFLSET)
Q 0
;
TP(INFO,NAME) ;
S @NAME=$$TRIM^XLFSTR($G(@NAME)) Q:@NAME=""
S INFO($O(INFO(""),-1)+1)=$$LJ^XLFSTR(NAME,8)_" = """_@NAME_""""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HROR10 6081 printed Sep 23, 2025@19:17:18 Page 2
ROR10 ;HCIOFO/SG - NIGHTLY TASK UTILITIES ; 11/29/05 4:21pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**18**;Feb 17, 2006;Build 25
+2 ;
+3 ;******************************************************************************
+4 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+5 ;----------- ---------- ----------- ----------------------------------------
+6 ;ROR*1.5*18 APR 2012 C RAY Replaces list in TASK PARAMETERS with
+7 ; list of all initialized registries
+8 ;******************************************************************************
+9 QUIT
+10 ;
+11 ;***** DISPLAYS THE ALERT ABOUT PROBLEMATIC HL7 MESSAGES
ALERT ;
+1 if $GET(XQADATA)=""
QUIT
+2 NEW I,PARAMS,RORINFO,TMP
+3 ;--- Get and prepare the parameters
+4 SET PARAMS("REGISTRY")=$PIECE(XQADATA,"^")
+5 SET PARAMS("NOR")=$PIECE(XQADATA,"^",2)
+6 ;--- Load and format the text
+7 DO BLD^DIALOG(7980000.027,.PARAMS,,"RORINFO","S")
+8 ;--- Display the text
+9 SET I=""
WRITE !!
+10 FOR
SET I=$ORDER(RORINFO(I))
if I=""
QUIT
WRITE RORINFO(I),!
+11 QUIT
+12 ;
+13 ;***** CHECKS THE STATUS OF LAST HL7 MESSAGE(S)
+14 ;
+15 ; .REGLST Reference to a local array containing registry
+16 ; names as subscripts and (optionally) registry
+17 ; IENs as values.
+18 ;
+19 ; Return values:
+20 ; <0 Error code
+21 ; 0 Ok
+22 ;
CHECKMSG(REGLST) ;
+1 ; List of latest batch HL7 messages (see ^ROR11)
NEW RORLBLST
+2 ;
+3 NEW HDTIEN,IENS,IM,LBCID,MSGDT,MSGSTC,RC,REGIEN,REGNAME,RORBUF,RORFDA,RORMSG,TMP
+4 SET RC=0
+5 ;
+6 ;=== Compile the list of latest batch HL7 messages
+7 SET REGNAME=""
+8 FOR
SET REGNAME=$ORDER(REGLST(REGNAME))
if REGNAME=""
QUIT
Begin DoDot:1
+9 ;--- Get the registry IEN
+10 SET REGIEN=+$GET(REGLST(REGNAME))
+11 IF REGIEN'>0
Begin DoDot:2
+12 SET REGIEN=$$REGIEN^RORUTL02(REGNAME)
End DoDot:2
IF REGIEN'>0
SET RC=+REGIEN
QUIT
+13 SET $PIECE(REGLST(REGNAME),U)=REGIEN
+14 ;--- Get the list of batch HL7 message IDs
+15 KILL RORBUF,RORMSG
+16 SET IENS=","_REGIEN_","
+17 DO LIST^DIC(798.122,IENS,"@;.01;.02;.03I",,,,,"B",,,"RORBUF","RORMSG")
+18 IF $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,798.122,IENS)
QUIT
+19 ;--- Update the list of latest HL7 batch messages
+20 SET IM=""
+21 FOR
SET IM=$ORDER(RORBUF("DILIST","ID",IM))
if IM=""
QUIT
Begin DoDot:2
+22 SET LBCID=RORBUF("DILIST","ID",IM,.01)
+23 SET IENS=RORBUF("DILIST",2,IM)_","_REGIEN_","
+24 SET MSGDT=$GET(RORBUF("DILIST","ID",IM,.03))
+25 DO ADDMSG^ROR11(LBCID,IENS,$GET(RORBUF("DILIST","ID",IM,.02)),MSGDT)
End DoDot:2
End DoDot:1
if RC<0
QUIT
+26 if RC<0
QUIT RC
+27 ;
+28 ;=== Analyze the list of messages
+29 SET LBCID=0
+30 FOR
SET LBCID=$ORDER(RORLBLST(LBCID))
if LBCID'>0
QUIT
Begin DoDot:1
+31 SET MSGSTC=+RORLBLST(LBCID,"MS")
+32 SET MSGDT=RORLBLST(LBCID,"DT")
+33 ;--- If the message does not exist (usually, it should), remove
+34 ; the reference(s) but do not update the patients' extraction
+35 ;--- dates. Data will be re-extracted and resent (just in case).
+36 IF 'MSGSTC
Begin DoDot:2
+37 DO DELMSG^ROR11(LBCID,.RORFDA)
+38 DO ERROR^RORERR(-49,,,,LBCID)
End DoDot:2
QUIT
+39 ;--- Unfortunately, the 'successfully completed' status (3) is
+40 ; returned for cancelled messages as well (and possibly in
+41 ; some other situations). Update the patients' extraction
+42 ; dates only if there is no error message in the status
+43 ;--- string. Then remove the message reference(s).
+44 IF MSGSTC=3
Begin DoDot:2
+45 SET TMP=$PIECE(RORLBLST(LBCID,"MS"),U,3)
+46 if TMP=""
SET TMP=$$UPDTRR^ROR11($PIECE(RORLBLST(LBCID),U),MSGDT)
+47 DO DELMSG^ROR11(LBCID,.RORFDA)
End DoDot:2
QUIT
+48 ;--- If the message is being processed/transmitted,
+49 ;--- then keep the reference(s) in the list.
+50 IF (MSGSTC=1.5)!(MSGSTC=1.7)
Begin DoDot:2
+51 DO ERROR^RORERR(-73,,,,LBCID)
End DoDot:2
QUIT
+52 ;--- Otherwise (the message has not been sent), keep the
+53 ;--- reference(s) and requeue the message (just in case).
+54 SET TMP=+$$MSGACT^HLUTIL(LBCID,2)
+55 DO ERROR^RORERR($SELECT(TMP:-93,1:-92),,,,LBCID)
End DoDot:1
if RC<0
QUIT
+56 if RC<0
QUIT RC
+57 ;
+58 SET REGNAME=""
+59 FOR
SET REGNAME=$ORDER(REGLST(REGNAME))
if REGNAME=""
QUIT
Begin DoDot:1
+60 ;--- Get the registry IEN
+61 SET REGIEN=+$GET(REGLST(REGNAME))
if REGIEN'>0
QUIT
+62 SET IENS=REGIEN_","
+63 ;--- Check if all registry messages have been sent
+64 IF $DATA(RORLBLST("RM",REGIEN))<10
if $DATA(RORLBLST("RM",REGIEN))
Begin DoDot:2
+65 KILL RORLBLST("RM",REGIEN)
+66 ;--- Clear the HL7 ATTEMPT COUNTER field
+67 SET RORFDA(798.1,IENS,19.3)="@"
+68 ;--- Check for an automatic backpull definition
+69 SET HDTIEN=$$GET1^DIQ(798.1,IENS,21.01,"I",,"RORMSG")
+70 IF $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,,798.1,IENS)
QUIT
+71 if HDTIEN>0
Begin DoDot:3
+72 ;--- Reset the automatic backpull mode
+73 SET RORFDA(798.1,IENS,21.01)="@"
+74 ;--- Complete the automatic backpull
+75 SET TMP=$$COMPLETE^RORHDT06(HDTIEN,REGNAME)
End DoDot:3
End DoDot:2
QUIT
+76 ;--- Increment the HL7 ATTEMPT COUNTER for registries with unsent
+77 ;--- message(s) and exclude those registries from data extraction.
+78 SET TMP=$$GET1^DIQ(798.1,IENS,19.3,,,"RORMSG")
+79 if $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,,798.1,IENS)
+80 SET RORFDA(798.1,IENS,19.3)=TMP+1
+81 KILL REGLST(REGNAME)
End DoDot:1
+82 ;
+83 ;=== Update the registry parameters if necessary
+84 if $DATA(RORFDA)>1
Begin DoDot:1
+85 DO FILE^DIE(,"RORFDA","RORMSG")
+86 if $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,,798.1)
End DoDot:1
+87 ;
+88 ;=== Notify the AAC and local coordinators if necessary
+89 if $DATA(RORLBLST("RM"))>1
DO NOTIFY^ROR11()
+90 ;
+91 ;=== Success
+92 QUIT 0
+93 ;
+94 ;***** PROCESSES THE TASK PARAMETERS
+95 ;
+96 ; .REGLST Reference to a local variable where the list of
+97 ; registry names is returned to
+98 ;
+99 ; Return values:
+100 ; <0 Error code
+101 ; 0 Ok
+102 ;
TASKPRMS(REGLST) ;
+1 NEW %DT,DTOUT,INFO,REGNAME,TMP,X,Y
+2 ;--- Log the task parameters
+3 DO TP(.INFO,"RORFLSET")
+4 DO TP(.INFO,"RORFLCLR")
+5 DO TP(.INFO,"RORMNTSK")
+6 DO TP(.INFO,"RORSUSP")
+7 DO LOG^RORLOG(,"Task Parameters",,.INFO)
+8 ;--- Maximum number of subtasks
+9 SET RORMNTSK=$SELECT(RORMNTSK'="":$TRANSLATE(RORMNTSK,"-","^"),1:"2^3^AUTO")
+10 ;--- Suspension parameters
+11 if RORSUSP'=""
Begin DoDot:1
+12 SET TMP=RORSUSP
SET RORSUSP=""
+13 FOR I=1,2
Begin DoDot:2
+14 SET X=$PIECE(TMP,"-",I)
SET %DT="R"
DO ^%DT
End DoDot:2
if $GET(Y)>0
SET $PIECE(RORSUSP,"^",I)=Y#1
End DoDot:1
+15 ;only initialized registries
SET RC=$$REGSEL^RORUTL01("I")
+16 if RC<0
QUIT RC
+17 ;--- Flags
+18 SET RORFLCLR=$$UP^XLFSTR(RORFLCLR)
+19 SET RORFLSET=$$UP^XLFSTR(RORFLSET)
+20 QUIT 0
+21 ;
TP(INFO,NAME) ;
+1 SET @NAME=$$TRIM^XLFSTR($GET(@NAME))
if @NAME=""
QUIT
+2 SET INFO($ORDER(INFO(""),-1)+1)=$$LJ^XLFSTR(NAME,8)_" = """_@NAME_""""
+3 QUIT
