Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ROR10

ROR10.m

Go to the documentation of this file.
  1. ROR10 ;HCIOFO/SG - NIGHTLY TASK UTILITIES ; 11/29/05 4:21pm
  1. ;;1.5;CLINICAL CASE REGISTRIES;**18**;Feb 17, 2006;Build 25
  1. ;
  1. ;******************************************************************************
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*18 APR 2012 C RAY Replaces list in TASK PARAMETERS with
  1. ; list of all initialized registries
  1. ;******************************************************************************
  1. Q
  1. ;
  1. ;***** DISPLAYS THE ALERT ABOUT PROBLEMATIC HL7 MESSAGES
  1. ALERT ;
  1. Q:$G(XQADATA)=""
  1. N I,PARAMS,RORINFO,TMP
  1. ;--- Get and prepare the parameters
  1. S PARAMS("REGISTRY")=$P(XQADATA,"^")
  1. S PARAMS("NOR")=$P(XQADATA,"^",2)
  1. ;--- Load and format the text
  1. D BLD^DIALOG(7980000.027,.PARAMS,,"RORINFO","S")
  1. ;--- Display the text
  1. S I="" W !!
  1. F S I=$O(RORINFO(I)) Q:I="" W RORINFO(I),!
  1. Q
  1. ;
  1. ;***** CHECKS THE STATUS OF LAST HL7 MESSAGE(S)
  1. ;
  1. ; .REGLST Reference to a local array containing registry
  1. ; names as subscripts and (optionally) registry
  1. ; IENs as values.
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. CHECKMSG(REGLST) ;
  1. N RORLBLST ; List of latest batch HL7 messages (see ^ROR11)
  1. ;
  1. N HDTIEN,IENS,IM,LBCID,MSGDT,MSGSTC,RC,REGIEN,REGNAME,RORBUF,RORFDA,RORMSG,TMP
  1. S RC=0
  1. ;
  1. ;=== Compile the list of latest batch HL7 messages
  1. S REGNAME=""
  1. F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
  1. . ;--- Get the registry IEN
  1. . S REGIEN=+$G(REGLST(REGNAME))
  1. . I REGIEN'>0 D I REGIEN'>0 S RC=+REGIEN Q
  1. . . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
  1. . S $P(REGLST(REGNAME),U)=REGIEN
  1. . ;--- Get the list of batch HL7 message IDs
  1. . K RORBUF,RORMSG
  1. . S IENS=","_REGIEN_","
  1. . D LIST^DIC(798.122,IENS,"@;.01;.02;.03I",,,,,"B",,,"RORBUF","RORMSG")
  1. . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.122,IENS) Q
  1. . ;--- Update the list of latest HL7 batch messages
  1. . S IM=""
  1. . F S IM=$O(RORBUF("DILIST","ID",IM)) Q:IM="" D
  1. . . S LBCID=RORBUF("DILIST","ID",IM,.01)
  1. . . S IENS=RORBUF("DILIST",2,IM)_","_REGIEN_","
  1. . . S MSGDT=$G(RORBUF("DILIST","ID",IM,.03))
  1. . . D ADDMSG^ROR11(LBCID,IENS,$G(RORBUF("DILIST","ID",IM,.02)),MSGDT)
  1. Q:RC<0 RC
  1. ;
  1. ;=== Analyze the list of messages
  1. S LBCID=0
  1. F S LBCID=$O(RORLBLST(LBCID)) Q:LBCID'>0 D Q:RC<0
  1. . S MSGSTC=+RORLBLST(LBCID,"MS")
  1. . S MSGDT=RORLBLST(LBCID,"DT")
  1. . ;--- If the message does not exist (usually, it should), remove
  1. . ; the reference(s) but do not update the patients' extraction
  1. . ;--- dates. Data will be re-extracted and resent (just in case).
  1. . I 'MSGSTC D Q
  1. . . D DELMSG^ROR11(LBCID,.RORFDA)
  1. . . D ERROR^RORERR(-49,,,,LBCID)
  1. . ;--- Unfortunately, the 'successfully completed' status (3) is
  1. . ; returned for cancelled messages as well (and possibly in
  1. . ; some other situations). Update the patients' extraction
  1. . ; dates only if there is no error message in the status
  1. . ;--- string. Then remove the message reference(s).
  1. . I MSGSTC=3 D Q
  1. . . S TMP=$P(RORLBLST(LBCID,"MS"),U,3)
  1. . . S:TMP="" TMP=$$UPDTRR^ROR11($P(RORLBLST(LBCID),U),MSGDT)
  1. . . D DELMSG^ROR11(LBCID,.RORFDA)
  1. . ;--- If the message is being processed/transmitted,
  1. . ;--- then keep the reference(s) in the list.
  1. . I (MSGSTC=1.5)!(MSGSTC=1.7) D Q
  1. . . D ERROR^RORERR(-73,,,,LBCID)
  1. . ;--- Otherwise (the message has not been sent), keep the
  1. . ;--- reference(s) and requeue the message (just in case).
  1. . S TMP=+$$MSGACT^HLUTIL(LBCID,2)
  1. . D ERROR^RORERR($S(TMP:-93,1:-92),,,,LBCID)
  1. Q:RC<0 RC
  1. ;
  1. S REGNAME=""
  1. F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D
  1. . ;--- Get the registry IEN
  1. . S REGIEN=+$G(REGLST(REGNAME)) Q:REGIEN'>0
  1. . S IENS=REGIEN_","
  1. . ;--- Check if all registry messages have been sent
  1. . I $D(RORLBLST("RM",REGIEN))<10 D:$D(RORLBLST("RM",REGIEN)) Q
  1. . . K RORLBLST("RM",REGIEN)
  1. . . ;--- Clear the HL7 ATTEMPT COUNTER field
  1. . . S RORFDA(798.1,IENS,19.3)="@"
  1. . . ;--- Check for an automatic backpull definition
  1. . . S HDTIEN=$$GET1^DIQ(798.1,IENS,21.01,"I",,"RORMSG")
  1. . . I $G(DIERR) D DBS^RORERR("RORMSG",-9,,,798.1,IENS) Q
  1. . . D:HDTIEN>0
  1. . . . ;--- Reset the automatic backpull mode
  1. . . . S RORFDA(798.1,IENS,21.01)="@"
  1. . . . ;--- Complete the automatic backpull
  1. . . . S TMP=$$COMPLETE^RORHDT06(HDTIEN,REGNAME)
  1. . ;--- Increment the HL7 ATTEMPT COUNTER for registries with unsent
  1. . ;--- message(s) and exclude those registries from data extraction.
  1. . S TMP=$$GET1^DIQ(798.1,IENS,19.3,,,"RORMSG")
  1. . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,798.1,IENS)
  1. . S RORFDA(798.1,IENS,19.3)=TMP+1
  1. . K REGLST(REGNAME)
  1. ;
  1. ;=== Update the registry parameters if necessary
  1. D:$D(RORFDA)>1
  1. . D FILE^DIE(,"RORFDA","RORMSG")
  1. . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,798.1)
  1. ;
  1. ;=== Notify the AAC and local coordinators if necessary
  1. D:$D(RORLBLST("RM"))>1 NOTIFY^ROR11()
  1. ;
  1. ;=== Success
  1. Q 0
  1. ;
  1. ;***** PROCESSES THE TASK PARAMETERS
  1. ;
  1. ; .REGLST Reference to a local variable where the list of
  1. ; registry names is returned to
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. TASKPRMS(REGLST) ;
  1. N %DT,DTOUT,INFO,REGNAME,TMP,X,Y
  1. ;--- Log the task parameters
  1. D TP(.INFO,"RORFLSET")
  1. D TP(.INFO,"RORFLCLR")
  1. D TP(.INFO,"RORMNTSK")
  1. D TP(.INFO,"RORSUSP")
  1. D LOG^RORLOG(,"Task Parameters",,.INFO)
  1. ;--- Maximum number of subtasks
  1. S RORMNTSK=$S(RORMNTSK'="":$TR(RORMNTSK,"-","^"),1:"2^3^AUTO")
  1. ;--- Suspension parameters
  1. D:RORSUSP'=""
  1. . S TMP=RORSUSP,RORSUSP=""
  1. . F I=1,2 D S:$G(Y)>0 $P(RORSUSP,"^",I)=Y#1
  1. . . S X=$P(TMP,"-",I),%DT="R" D ^%DT
  1. S RC=$$REGSEL^RORUTL01("I") ;only initialized registries
  1. Q:RC<0 RC
  1. ;--- Flags
  1. S RORFLCLR=$$UP^XLFSTR(RORFLCLR)
  1. S RORFLSET=$$UP^XLFSTR(RORFLSET)
  1. Q 0
  1. ;
  1. TP(INFO,NAME) ;
  1. S @NAME=$$TRIM^XLFSTR($G(@NAME)) Q:@NAME=""
  1. S INFO($O(INFO(""),-1)+1)=$$LJ^XLFSTR(NAME,8)_" = """_@NAME_""""
  1. Q