- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGHLLOG.m
r613 r623 1 RGHLLOG ;CAIRO/DKM-LOG MESSAGE PROCESSING INFO ;09/04/98 2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,11,13,18,19,25,45,52**;30 Apr 99;Build 2 3 ; 4 ;Reference to ^HLMA("C" supported by IA #3244 5 ;================================================================= 6 ; Log information about message processing and exceptions 7 ; in CIRN HL7 Exception Log file. 8 ;================================================================= 9 ; Start time for run log 10 START(RGMSG,RGDC,RGPARAM) ; 11 ;This entry point starts the log process in the CIRN HL7 EXCEPTION LOG 12 ;file (#991.1), if the (#6) MINIMAL EXCEPTION LOGGING? field in 13 ;File #990.8 is set to 0. 14 ; Input: Required 15 ; RGMSG - IEN of message entry in File #773, usually HLMTIEN 16 ; Optional 17 ; RGDC - Event Class, associated with an entry in File # 18 ; RGPARAM - reprocessing routine 19 S U="^" 20 K RGLOG 21 S RGLOG(3)=$G(RGMSG),RGLOG(5)=$G(RGDC),RGLOG(4)=$G(RGPARAM),RGLOG(1)=$$NOW^XLFDT 22 I '$P(^RGSITE("COR",1,0),U,8) S RGLOG=$$CREATE 23 Q 24 ; Create a log entry 25 CREATE() Q:$G(RGLOG) RGLOG 26 L +^RGHL7(991.1,0):10 27 S RGLOG=$O(^RGHL7(991.1,$C(32)),-1)+1 28 S:$G(RGLOG(1))="" RGLOG(1)=$$NOW^XLFDT 29 S RGLOG(3)=$S($G(RGLOG(3))=0:0,$G(HL("MID"))="":"",1:$$IEN773($G(HL("MID")))) 30 S (DA,X)=RGLOG,DIC="^RGHL7(991.1,",DIC(0)="L",DLAYGO=991.1,DIC("DR")="1///"_$G(RGLOG(1))_";3////"_$G(RGLOG(3))_";5///"_$G(RGLOG(5))_";4////"_$G(RGLOG(4)) K DD,DO D FILE^DICN K DIC,DA,X,DLAYGO 31 L -^RGHL7(991.1,0) 32 Q RGLOG 33 ; Log time run completed 34 STOP(RGQUIT) ; 35 ;This entry point completes the logging process 36 ; Input: required 37 ; RGQUIT - 0 for success and 1 for failure 38 ; 39 Q:'$G(RGLOG) 40 L +^RGHL7(991.1,RGLOG):10 41 S DIE="^RGHL7(991.1,",DR="1.5///NOW;1.6///^S X=$G(RGQUIT)",DA=RGLOG D ^DIE K DIE,DA,DR 42 L -^RGHL7(991.1,RGLOG) 43 K RGLOG,RGQUIT,X,Y,DIC,DIE 44 Q 45 ; Log unclassified exception (old entry point) 46 ERR(RGERR,RGSEV) ; 47 D EXC(18,RGERR) 48 S RGQUIT=$G(RGQUIT)!$G(RGSEV) 49 Q 50 ; Log an exception 51 EXC(RGEXC,RGERR,RGDFN,MSGID,STATNUM) ; 52 ;This entry point logs exceptions in the CIRN HL7 EXCEPTION LOG 53 ;file (#991.1) 54 ; Input: Required 55 ; RGEXC - Exception type in File #991.11 56 ; RGERR - Supplemental text 57 ; Optional 58 ; RGDFN - IEN in the PATIENT file (#2) 59 ; MSGID - message id of the HL7 message where the exception was encountered (optional) 60 ; STATNUM - station # of site that encountered the error (optional) - if not defined then the local site is assumed, using $$SITE^VASITE 61 ; 62 I (RGEXC=215)!(RGEXC=216)!(RGEXC=217) Q ;**52 until MPIFBT3 call eliminates these exception types 63 I $L($G(HL("MID"))) Q:$$INVEXC(HL("MID")) ; is the exception valid? 64 N RGI,RGZ 65 S U="^" 66 S:RGEXC[U RGERR=$P(RGEXC,U,2,999),RGEXC=+RGEXC 67 S:RGEXC'=+RGEXC RGERR=RGEXC,RGEXC=18 68 S:'$D(^RGHL7(991.11,RGEXC)) RGEXC=18 69 L +^RGHL7(991.11,RGEXC):10 70 S RGZ=$G(^RGHL7(991.11,RGEXC,0)) 71 S:$L(RGZ) $P(^RGHL7(991.11,RGEXC,0),U,5)=$P(RGZ,U,5)+1 72 S:$P(RGZ,U,2)>1 RGQUIT=1 73 L -^RGHL7(991.11,RGEXC) 74 S RGLOG=$$CREATE 75 L +^RGHL7(991.1,RGLOG):10 76 S RGI=$O(^RGHL7(991.1,RGLOG,1,$C(32)),-1)+1 77 S RGERR=$E($G(RGERR),1,250) 78 S DIC="^RGHL7(991.1,"_RGLOG_",1," 79 S X=RGI,DA(1)=RGLOG,DIC(0)="FL",DLAYGO=991.12,DIC("P")=$P(^DD(991.1,2,0),"^",2) 80 D ^DIC 81 S DIE=DIC 82 K DIC,DA,DR,DLAYGO 83 S STAT=0 84 S DIC="3.8",DIC(0)="Z",X="MPIF EXCEPTIONS" D ^DIC K DIC 85 S RGMG=$P($G(Y),"^",1) 86 I $P(^RGHL7(991.11,RGEXC,0),U,4)=RGMG S STAT=1 87 S DA(1)=RGLOG,DA=RGI,DR="2///"_$G(RGEXC)_";3///"_$S($G(RGDFN):"`"_RGDFN,1:"")_";6///"_$G(STAT)_";10///"_$G(RGERR) 88 D ^DIE K DIE,DA,DR 89 L -^RGHL7(991.1,RGLOG) 90 S RGI=$P(RGZ,U,3),RGZ=$P(RGZ,U,4) 91 ; 92 ;If the action type is for the MPI Exception Handler, send exception to the handler and quit 93 I (RGI=3) D SENDMPI^RGHLLOG1($G(RGEXC),$G(RGERR),$G(RGDFN),$G(MSGID),$G(STATNUM)) Q 94 ; 95 Q:'RGI!'RGZ 96 ;quit and don't send messages for exception types that are now being 97 ;handled through the MPI/PD Exception Handling option. 98 Q:RGEXC=234!(RGEXC=218) ;MPIC_772; **52 remove 215, 216, and 217 99 S DIC="^XMB(3.8,",DIC(0)="NZ",X="`"_RGZ D ^DIC K DIC Q:+Y<1 S RGZ=$P(Y,U,2) K Y 100 Q:RGZ=""!$P($G(^RGSITE("COR",1,0)),U,7) 101 S RGERR=$$SHORT(RGEXC,RGERR),RGZ="G."_RGZ 102 I RGI=2 D ALERT^RGRSUTL2(RGERR,RGZ) Q 103 D MAIL^RGRSUTL2(RGERR,RGZ,"MPI/PD Exception: "_$$SHORT(RGEXC),"MPI/PD exception notification") 104 Q 105 ; 106 INVEXC(RGMID) ; determine if this exception needs to be sent to MPI/PD 107 ; personnel via FORUM. Return 1 to avoid messaging to FORUM, else 0. 108 ; IA#:3244 is applied in this functionality 109 N RGFLG,RGIEN S RGFLG=1 110 S RGIEN=$$IEN773(RGMID) Q:'RGIEN RGFLG 111 S RGIEN("SND")=$$GET1^DIQ(773,RGIEN_",",13) 112 S RGIEN("REC")=$$GET1^DIQ(773,RGIEN_",",14) 113 ; check the sending application (fld:13, 0;11) & the receiving 114 ; application (fld:14, 0;12) to see if they are related to the MPI/PD 115 ; project. 116 I RGIEN("SND")]""!(RGIEN("REC")]"") D Q RGFLG 117 .S RGFLG=$$APP(RGIEN("SND")) Q:'RGFLG 118 .S RGFLG=$$APP(RGIEN("REC")) 119 .Q 120 ; Only if the sending/receiving applications cannot be determined from 121 ; the data in their respective fields, do I check the MSH multiple for 122 ; the MSH segment. I identify the sending/receiving application from 123 ; this segment. 124 E D 125 .N RG,RG1,RGMSH,RGFS 126 .D GETS^DIQ(773,RGIEN_",",200,,"RGMSH") ;check MSH mult for snd/rec app 127 .Q:'($D(RGMSH)\10) ; no data in "MSH" multiple for file 773 128 .S RGIEN=RGIEN_",",RG="RGMSH(773,"""_RGIEN_""","_200_")" 129 .S RG1=0 F S RG1=$O(@RG@(RG1)) Q:RG1'>0 D Q:$E($G(@RG@(RG1)),1,3)="MSH" 130 ..I $E($G(@RG@(RG1)),1,3)="MSH" D 131 ...S RG(0)=$G(@RG@(RG1)),RGFS=$E(RG(0),4) 132 ...S:$P(RG(0),RGFS,3)]"" RGFLG=$$APP($P(RG(0),RGFS,3)) Q:'RGFLG 133 ...S:$P(RG(0),RGFS,5)]"" RGFLG=$$APP($P(RG(0),RGFS,5)) 134 ...Q 135 ..Q 136 .Q 137 Q RGFLG 138 APP(X) ; check if the sending/receiving application is relevant to the 139 ; MPI/PD team. Returns 1 if a non-relevant namespace, else 0 140 I $E(X,1,2)="RG"!($E(X,1,2)="VA")!($E(X,1,3)="MPI") Q 0 141 Q 1 142 ; 143 IEN773(RGMID) ; find the ien of the record in the HL7 MESSAGE ADMINISTRATION 144 ; (#773) file based on the Message ID. Input: Message ID 145 ; Output: null, no record in 773, else 773 record ien. IA#: 3244 146 Q:$G(RGMID)="" "" 147 Q $O(^HLMA("C",RGMID,0)) 148 ; 149 SHORT(RGEXC,RGTXT) ; 150 ; Retrieve short text description of exception 151 Q $G(^RGHL7(991.11,+RGEXC,10))_$S($G(RGTXT)="":"",1:": "_RGTXT) 152 ; 1 RGHLLOG ;CAIRO/DKM-LOG MESSAGE PROCESSING INFO ;09/04/98 2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,11,13,18,19,25,45**;30 Apr 99;Build 9 3 ;Reference to ^HLMA("C" supported by IA #3244 4 ;================================================================= 5 ; Log information about message processing and exceptions 6 ; in CIRN HL7 Exception Log file. 7 ;================================================================= 8 ; Start time for run log 9 START(RGMSG,RGDC,RGPARAM) ; 10 ;This entry point starts the log process in the CIRN HL7 EXCEPTION LOG 11 ;file (#991.1), if the (#6) MINIMAL EXCEPTION LOGGING? field in 12 ;File #990.8 is set to 0. 13 ; Input: Required 14 ; RGMSG - IEN of message entry in File #773, usually HLMTIEN 15 ; Optional 16 ; RGDC - Event Class, associated with an entry in File # 17 ; RGPARAM - reprocessing routine 18 S U="^" 19 K RGLOG 20 S RGLOG(3)=$G(RGMSG),RGLOG(5)=$G(RGDC),RGLOG(4)=$G(RGPARAM),RGLOG(1)=$$NOW^XLFDT 21 I '$P(^RGSITE("COR",1,0),U,8) S RGLOG=$$CREATE 22 Q 23 ; Create a log entry 24 CREATE() Q:$G(RGLOG) RGLOG 25 L +^RGHL7(991.1,0):10 26 S RGLOG=$O(^RGHL7(991.1,$C(32)),-1)+1 27 S:$G(RGLOG(1))="" RGLOG(1)=$$NOW^XLFDT 28 S RGLOG(3)=$S($G(RGLOG(3))=0:0,$G(HL("MID"))="":"",1:$$IEN773($G(HL("MID")))) 29 S (DA,X)=RGLOG,DIC="^RGHL7(991.1,",DIC(0)="L",DLAYGO=991.1,DIC("DR")="1///"_$G(RGLOG(1))_";3////"_$G(RGLOG(3))_";5///"_$G(RGLOG(5))_";4////"_$G(RGLOG(4)) K DD,DO D FILE^DICN K DIC,DA,X,DLAYGO 30 L -^RGHL7(991.1,0) 31 Q RGLOG 32 ; Log time run completed 33 STOP(RGQUIT) ; 34 ;This entry point completes the logging process 35 ; Input: required 36 ; RGQUIT - 0 for success and 1 for failure 37 ; 38 Q:'$G(RGLOG) 39 L +^RGHL7(991.1,RGLOG):10 40 S DIE="^RGHL7(991.1,",DR="1.5///NOW;1.6///^S X=$G(RGQUIT)",DA=RGLOG D ^DIE K DIE,DA,DR 41 L -^RGHL7(991.1,RGLOG) 42 K RGLOG,RGQUIT,X,Y,DIC,DIE 43 Q 44 ; Log unclassified exception (old entry point) 45 ERR(RGERR,RGSEV) ; 46 D EXC(18,RGERR) 47 S RGQUIT=$G(RGQUIT)!$G(RGSEV) 48 Q 49 ; Log an exception 50 EXC(RGEXC,RGERR,RGDFN,MSGID,STATNUM) ; 51 ;This entry point logs exceptions in the CIRN HL7 EXCEPTION LOG 52 ;file (#991.1) 53 ; Input: Required 54 ; RGEXC - Exception type in File #991.11 55 ; RGERR - Supplemental text 56 ; Optional 57 ; RGDFN - IEN in the PATIENT file (#2) 58 ; MSGID - message id of the HL7 message where the exception was encountered (optional) 59 ; STATNUM - station # of site that encountered the error (optional) - if not defined then the local site is assumed, using $$SITE^VASITE 60 ; 61 I $L($G(HL("MID"))) Q:$$INVEXC(HL("MID")) ; is the exception valid? 62 N RGI,RGZ 63 S U="^" 64 S:RGEXC[U RGERR=$P(RGEXC,U,2,999),RGEXC=+RGEXC 65 S:RGEXC'=+RGEXC RGERR=RGEXC,RGEXC=18 66 S:'$D(^RGHL7(991.11,RGEXC)) RGEXC=18 67 L +^RGHL7(991.11,RGEXC):10 68 S RGZ=$G(^RGHL7(991.11,RGEXC,0)) 69 S:$L(RGZ) $P(^RGHL7(991.11,RGEXC,0),U,5)=$P(RGZ,U,5)+1 70 S:$P(RGZ,U,2)>1 RGQUIT=1 71 L -^RGHL7(991.11,RGEXC) 72 S RGLOG=$$CREATE 73 L +^RGHL7(991.1,RGLOG):10 74 S RGI=$O(^RGHL7(991.1,RGLOG,1,$C(32)),-1)+1 75 S RGERR=$E($G(RGERR),1,250) 76 S DIC="^RGHL7(991.1,"_RGLOG_",1," 77 S X=RGI,DA(1)=RGLOG,DIC(0)="FL",DLAYGO=991.12,DIC("P")=$P(^DD(991.1,2,0),"^",2) 78 D ^DIC 79 S DIE=DIC 80 K DIC,DA,DR,DLAYGO 81 S STAT=0 82 S DIC="3.8",DIC(0)="Z",X="MPIF EXCEPTIONS" D ^DIC K DIC 83 S RGMG=$P($G(Y),"^",1) 84 I $P(^RGHL7(991.11,RGEXC,0),U,4)=RGMG S STAT=1 85 S DA(1)=RGLOG,DA=RGI,DR="2///"_$G(RGEXC)_";3///"_$S($G(RGDFN):"`"_RGDFN,1:"")_";6///"_$G(STAT)_";10///"_$G(RGERR) 86 D ^DIE K DIE,DA,DR 87 L -^RGHL7(991.1,RGLOG) 88 S RGI=$P(RGZ,U,3),RGZ=$P(RGZ,U,4) 89 ; 90 ;If the action type is for the MPI Exception Handler, send exception to the handler and quit 91 I (RGI=3) D SENDMPI^RGHLLOG1($G(RGEXC),$G(RGERR),$G(RGDFN),$G(MSGID),$G(STATNUM)) Q 92 ; 93 Q:'RGI!'RGZ 94 ;quit and don't send messages for exception types that are now being 95 ;handled through the MPI/PD Exception Handling option. 96 Q:RGEXC=234!((RGEXC>214)&(RGEXC<219)) 97 S DIC="^XMB(3.8,",DIC(0)="NZ",X="`"_RGZ D ^DIC K DIC Q:+Y<1 S RGZ=$P(Y,U,2) K Y 98 Q:RGZ=""!$P($G(^RGSITE("COR",1,0)),U,7) 99 S RGERR=$$SHORT(RGEXC,RGERR),RGZ="G."_RGZ 100 I RGI=2 D ALERT^RGRSUTL2(RGERR,RGZ) Q 101 D MAIL^RGRSUTL2(RGERR,RGZ,"MPI/PD Exception: "_$$SHORT(RGEXC),"MPI/PD exception notification") 102 Q 103 ; 104 INVEXC(RGMID) ; determine if this exception needs to be sent to MPI/PD 105 ; personnel via FORUM. Return 1 to avoid messaging to FORUM, else 0. 106 ; IA#:3244 is applied in this functionality 107 N RGFLG,RGIEN S RGFLG=1 108 S RGIEN=$$IEN773(RGMID) Q:'RGIEN RGFLG 109 S RGIEN("SND")=$$GET1^DIQ(773,RGIEN_",",13) 110 S RGIEN("REC")=$$GET1^DIQ(773,RGIEN_",",14) 111 ; check the sending application (fld:13, 0;11) & the receiving 112 ; application (fld:14, 0;12) to see if they are related to the MPI/PD 113 ; project. 114 I RGIEN("SND")]""!(RGIEN("REC")]"") D Q RGFLG 115 .S RGFLG=$$APP(RGIEN("SND")) Q:'RGFLG 116 .S RGFLG=$$APP(RGIEN("REC")) 117 .Q 118 ; Only if the sending/receiving applications cannot be determined from 119 ; the data in their respective fields, do I check the MSH multiple for 120 ; the MSH segment. I identify the sending/receiving application from 121 ; this segment. 122 E D 123 .N RG,RG1,RGMSH,RGFS 124 .D GETS^DIQ(773,RGIEN_",",200,,"RGMSH") ;check MSH mult for snd/rec app 125 .Q:'($D(RGMSH)\10) ; no data in "MSH" multiple for file 773 126 .S RGIEN=RGIEN_",",RG="RGMSH(773,"""_RGIEN_""","_200_")" 127 .S RG1=0 F S RG1=$O(@RG@(RG1)) Q:RG1'>0 D Q:$E($G(@RG@(RG1)),1,3)="MSH" 128 ..I $E($G(@RG@(RG1)),1,3)="MSH" D 129 ...S RG(0)=$G(@RG@(RG1)),RGFS=$E(RG(0),4) 130 ...S:$P(RG(0),RGFS,3)]"" RGFLG=$$APP($P(RG(0),RGFS,3)) Q:'RGFLG 131 ...S:$P(RG(0),RGFS,5)]"" RGFLG=$$APP($P(RG(0),RGFS,5)) 132 ...Q 133 ..Q 134 .Q 135 Q RGFLG 136 APP(X) ; check if the sending/receiving application is relevant to the 137 ; MPI/PD team. Returns 1 if a non-relevant namespace, else 0 138 I $E(X,1,2)="RG"!($E(X,1,2)="VA")!($E(X,1,3)="MPI") Q 0 139 Q 1 140 ; 141 IEN773(RGMID) ; find the ien of the record in the HL7 MESSAGE ADMINISTRATION 142 ; (#773) file based on the Message ID. Input: Message ID 143 ; Output: null, no record in 773, else 773 record ien. IA#: 3244 144 Q:$G(RGMID)="" "" 145 Q $O(^HLMA("C",RGMID,0)) 146 ; 147 SHORT(RGEXC,RGTXT) ; 148 ; Retrieve short text description of exception 149 Q $G(^RGHL7(991.11,+RGEXC,10))_$S($G(RGTXT)="":"",1:": "_RGTXT) 150 ;
Note:
See TracChangeset
for help on using the changeset viewer.
