| [613] | 1 | ROR10 ;HCIOFO/SG - NIGHTLY TASK UTILITIES ; 11/29/05 4:21pm
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** DISPLAYS THE ALERT ABOUT PROBLEMATIC HL7 MESSAGES
|
|---|
| 7 | ALERT ;
|
|---|
| 8 | Q:$G(XQADATA)=""
|
|---|
| 9 | N I,PARAMS,RORINFO,TMP
|
|---|
| 10 | ;--- Get and prepare the parameters
|
|---|
| 11 | S PARAMS("REGISTRY")=$P(XQADATA,"^")
|
|---|
| 12 | S PARAMS("NOR")=$P(XQADATA,"^",2)
|
|---|
| 13 | ;--- Load and format the text
|
|---|
| 14 | D BLD^DIALOG(7980000.027,.PARAMS,,"RORINFO","S")
|
|---|
| 15 | ;--- Display the text
|
|---|
| 16 | S I="" W !!
|
|---|
| 17 | F S I=$O(RORINFO(I)) Q:I="" W RORINFO(I),!
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | ;***** CHECKS THE STATUS OF LAST HL7 MESSAGE(S)
|
|---|
| 21 | ;
|
|---|
| 22 | ; .REGLST Reference to a local array containing registry
|
|---|
| 23 | ; names as subscripts and (optionally) registry
|
|---|
| 24 | ; IENs as values.
|
|---|
| 25 | ;
|
|---|
| 26 | ; Return values:
|
|---|
| 27 | ; <0 Error code
|
|---|
| 28 | ; 0 Ok
|
|---|
| 29 | ;
|
|---|
| 30 | CHECKMSG(REGLST) ;
|
|---|
| 31 | N RORLBLST ; List of latest batch HL7 messages (see ^ROR11)
|
|---|
| 32 | ;
|
|---|
| 33 | N HDTIEN,IENS,IM,LBCID,MSGDT,MSGSTC,RC,REGIEN,REGNAME,RORBUF,RORFDA,RORMSG,TMP
|
|---|
| 34 | S RC=0
|
|---|
| 35 | ;
|
|---|
| 36 | ;=== Compile the list of latest batch HL7 messages
|
|---|
| 37 | S REGNAME=""
|
|---|
| 38 | F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
|
|---|
| 39 | . ;--- Get the registry IEN
|
|---|
| 40 | . S REGIEN=+$G(REGLST(REGNAME))
|
|---|
| 41 | . I REGIEN'>0 D I REGIEN'>0 S RC=+REGIEN Q
|
|---|
| 42 | . . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
|
|---|
| 43 | . S $P(REGLST(REGNAME),U)=REGIEN
|
|---|
| 44 | . ;--- Get the list of batch HL7 message IDs
|
|---|
| 45 | . K RORBUF,RORMSG
|
|---|
| 46 | . S IENS=","_REGIEN_","
|
|---|
| 47 | . D LIST^DIC(798.122,IENS,"@;.01;.02;.03I",,,,,"B",,,"RORBUF","RORMSG")
|
|---|
| 48 | . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.122,IENS) Q
|
|---|
| 49 | . ;--- Update the list of latest HL7 batch messages
|
|---|
| 50 | . S IM=""
|
|---|
| 51 | . F S IM=$O(RORBUF("DILIST","ID",IM)) Q:IM="" D
|
|---|
| 52 | . . S LBCID=RORBUF("DILIST","ID",IM,.01)
|
|---|
| 53 | . . S IENS=RORBUF("DILIST",2,IM)_","_REGIEN_","
|
|---|
| 54 | . . S MSGDT=$G(RORBUF("DILIST","ID",IM,.03))
|
|---|
| 55 | . . D ADDMSG^ROR11(LBCID,IENS,$G(RORBUF("DILIST","ID",IM,.02)),MSGDT)
|
|---|
| 56 | Q:RC<0 RC
|
|---|
| 57 | ;
|
|---|
| 58 | ;=== Analyze the list of messages
|
|---|
| 59 | S LBCID=0
|
|---|
| 60 | F S LBCID=$O(RORLBLST(LBCID)) Q:LBCID'>0 D Q:RC<0
|
|---|
| 61 | . S MSGSTC=+RORLBLST(LBCID,"MS")
|
|---|
| 62 | . S MSGDT=RORLBLST(LBCID,"DT")
|
|---|
| 63 | . ;--- If the message does not exist (usually, it should), remove
|
|---|
| 64 | . ; the reference(s) but do not update the patients' extraction
|
|---|
| 65 | . ;--- dates. Data will be re-extracted and resent (just in case).
|
|---|
| 66 | . I 'MSGSTC D Q
|
|---|
| 67 | . . D DELMSG^ROR11(LBCID,.RORFDA)
|
|---|
| 68 | . . D ERROR^RORERR(-49,,,,LBCID)
|
|---|
| 69 | . ;--- Unfortunately, the 'successfully completed' status (3) is
|
|---|
| 70 | . ; returned for cancelled messages as well (and possibly in
|
|---|
| 71 | . ; some other situations). Update the patients' extraction
|
|---|
| 72 | . ; dates only if there is no error message in the status
|
|---|
| 73 | . ;--- string. Then remove the message reference(s).
|
|---|
| 74 | . I MSGSTC=3 D Q
|
|---|
| 75 | . . S TMP=$P(RORLBLST(LBCID,"MS"),U,3)
|
|---|
| 76 | . . S:TMP="" TMP=$$UPDTRR^ROR11($P(RORLBLST(LBCID),U),MSGDT)
|
|---|
| 77 | . . D DELMSG^ROR11(LBCID,.RORFDA)
|
|---|
| 78 | . ;--- If the message is being processed/transmitted,
|
|---|
| 79 | . ;--- then keep the reference(s) in the list.
|
|---|
| 80 | . I (MSGSTC=1.5)!(MSGSTC=1.7) D Q
|
|---|
| 81 | . . D ERROR^RORERR(-73,,,,LBCID)
|
|---|
| 82 | . ;--- Otherwise (the message has not been sent), keep the
|
|---|
| 83 | . ;--- reference(s) and requeue the message (just in case).
|
|---|
| 84 | . S TMP=+$$MSGACT^HLUTIL(LBCID,2)
|
|---|
| 85 | . D ERROR^RORERR($S(TMP:-93,1:-92),,,,LBCID)
|
|---|
| 86 | Q:RC<0 RC
|
|---|
| 87 | ;
|
|---|
| 88 | S REGNAME=""
|
|---|
| 89 | F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D
|
|---|
| 90 | . ;--- Get the registry IEN
|
|---|
| 91 | . S REGIEN=+$G(REGLST(REGNAME)) Q:REGIEN'>0
|
|---|
| 92 | . S IENS=REGIEN_","
|
|---|
| 93 | . ;--- Check if all registry messages have been sent
|
|---|
| 94 | . I $D(RORLBLST("RM",REGIEN))<10 D:$D(RORLBLST("RM",REGIEN)) Q
|
|---|
| 95 | . . K RORLBLST("RM",REGIEN)
|
|---|
| 96 | . . ;--- Clear the HL7 ATTEMPT COUNTER field
|
|---|
| 97 | . . S RORFDA(798.1,IENS,19.3)="@"
|
|---|
| 98 | . . ;--- Check for an automatic backpull definition
|
|---|
| 99 | . . S HDTIEN=$$GET1^DIQ(798.1,IENS,21.01,"I",,"RORMSG")
|
|---|
| 100 | . . I $G(DIERR) D DBS^RORERR("RORMSG",-9,,,798.1,IENS) Q
|
|---|
| 101 | . . D:HDTIEN>0
|
|---|
| 102 | . . . ;--- Reset the automatic backpull mode
|
|---|
| 103 | . . . S RORFDA(798.1,IENS,21.01)="@"
|
|---|
| 104 | . . . ;--- Complete the automatic backpull
|
|---|
| 105 | . . . S TMP=$$COMPLETE^RORHDT06(HDTIEN,REGNAME)
|
|---|
| 106 | . ;--- Increment the HL7 ATTEMPT COUNTER for registries with unsent
|
|---|
| 107 | . ;--- message(s) and exclude those registries from data extraction.
|
|---|
| 108 | . S TMP=$$GET1^DIQ(798.1,IENS,19.3,,,"RORMSG")
|
|---|
| 109 | . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,798.1,IENS)
|
|---|
| 110 | . S RORFDA(798.1,IENS,19.3)=TMP+1
|
|---|
| 111 | . K REGLST(REGNAME)
|
|---|
| 112 | ;
|
|---|
| 113 | ;=== Update the registry parameters if necessary
|
|---|
| 114 | D:$D(RORFDA)>1
|
|---|
| 115 | . D FILE^DIE(,"RORFDA","RORMSG")
|
|---|
| 116 | . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,798.1)
|
|---|
| 117 | ;
|
|---|
| 118 | ;=== Notify the AAC and local coordinators if necessary
|
|---|
| 119 | D:$D(RORLBLST("RM"))>1 NOTIFY^ROR11()
|
|---|
| 120 | ;
|
|---|
| 121 | ;=== Success
|
|---|
| 122 | Q 0
|
|---|
| 123 | ;
|
|---|
| 124 | ;***** PROCESSES THE TASK PARAMETERS
|
|---|
| 125 | ;
|
|---|
| 126 | ; .REGLST Reference to a local variable where the list of
|
|---|
| 127 | ; registry names is returned to
|
|---|
| 128 | ;
|
|---|
| 129 | ; Return values:
|
|---|
| 130 | ; <0 Error code
|
|---|
| 131 | ; 0 Ok
|
|---|
| 132 | ;
|
|---|
| 133 | TASKPRMS(REGLST) ;
|
|---|
| 134 | N %DT,DTOUT,INFO,REGNAME,TMP,X,Y
|
|---|
| 135 | ;--- Log the task parameters
|
|---|
| 136 | D TP(.INFO,"ZTQPARAM")
|
|---|
| 137 | D TP(.INFO,"RORFLSET")
|
|---|
| 138 | D TP(.INFO,"RORFLCLR")
|
|---|
| 139 | D TP(.INFO,"RORMNTSK")
|
|---|
| 140 | D TP(.INFO,"RORSUSP")
|
|---|
| 141 | D LOG^RORLOG(,"Task Parameters",,.INFO)
|
|---|
| 142 | ;--- Check the task parameters
|
|---|
| 143 | I ZTQPARAM="" D Q RC
|
|---|
| 144 | . D TEXT^RORTXT(7980000.001,.INFO)
|
|---|
| 145 | . S RC=$$ERROR^RORERR(-88,,.INFO,,"TASK PARAMETERS")
|
|---|
| 146 | ;--- Maximum number of subtasks
|
|---|
| 147 | S RORMNTSK=$S(RORMNTSK'="":$TR(RORMNTSK,"-","^"),1:"2^3^AUTO")
|
|---|
| 148 | ;--- Suspension parameters
|
|---|
| 149 | D:RORSUSP'=""
|
|---|
| 150 | . S TMP=RORSUSP,RORSUSP=""
|
|---|
| 151 | . F I=1,2 D S:$G(Y)>0 $P(RORSUSP,"^",I)=Y#1
|
|---|
| 152 | . . S X=$P(TMP,"-",I),%DT="R" D ^%DT
|
|---|
| 153 | ;--- Extract registry names from task parameters
|
|---|
| 154 | F I=1:1 S REGNAME=$P(ZTQPARAM,",",I) Q:REGNAME="" D
|
|---|
| 155 | . S REGNAME=$$TRIM^XLFSTR(REGNAME)
|
|---|
| 156 | . S:REGNAME'="" REGLST(REGNAME)=""
|
|---|
| 157 | ;--- Flags
|
|---|
| 158 | S RORFLCLR=$$UP^XLFSTR(RORFLCLR)
|
|---|
| 159 | S RORFLSET=$$UP^XLFSTR(RORFLSET)
|
|---|
| 160 | Q 0
|
|---|
| 161 | ;
|
|---|
| 162 | TP(INFO,NAME) ;
|
|---|
| 163 | S @NAME=$$TRIM^XLFSTR($G(@NAME)) Q:@NAME=""
|
|---|
| 164 | S INFO($O(INFO(""),-1)+1)=$$LJ^XLFSTR(NAME,8)_" = """_@NAME_""""
|
|---|
| 165 | Q
|
|---|
