- 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 Feb 18, 2025@23:07:42 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