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

RGHLLOG.m

Go to the documentation of this file.
  1. RGHLLOG ;CAIRO/DKM-LOG MESSAGE PROCESSING INFO ;09/04/98
  1. ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,11,13,18,19,25,45,52,57,59,62**;30 Apr 99;Build 3
  1. ;
  1. ;Reference to ^HLMA("C" supported by IA #3244
  1. ;=================================================================
  1. ; Log information about message processing and exceptions
  1. ; in CIRN HL7 Exception Log file.
  1. ;=================================================================
  1. ; Start time for run log
  1. START(RGMSG,RGDC,RGPARAM) ;
  1. ;This entry point starts the log process in the CIRN HL7 EXCEPTION LOG
  1. ;file (#991.1), if the (#6) MINIMAL EXCEPTION LOGGING? field in
  1. ;File #990.8 is set to 0.
  1. ; Input: Required
  1. ; RGMSG - IEN of message entry in File #773, usually HLMTIEN
  1. ; Optional
  1. ; RGDC - Event Class, associated with an entry in File #
  1. ; RGPARAM - reprocessing routine
  1. S U="^"
  1. K RGLOG
  1. S RGLOG(3)=$G(RGMSG),RGLOG(5)=$G(RGDC),RGLOG(4)=$G(RGPARAM),RGLOG(1)=$$NOW^XLFDT
  1. I '$P(^RGSITE("COR",1,0),U,8) S RGLOG=$$CREATE
  1. Q
  1. ; Create a log entry
  1. CREATE() Q:$G(RGLOG) RGLOG
  1. L +^RGHL7(991.1,0):10
  1. S RGLOG=$O(^RGHL7(991.1,$C(32)),-1)+1
  1. S:$G(RGLOG(1))="" RGLOG(1)=$$NOW^XLFDT
  1. S RGLOG(3)=$S($G(RGLOG(3))=0:0,$G(HL("MID"))="":"",1:$$IEN773($G(HL("MID"))))
  1. 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
  1. L -^RGHL7(991.1,0)
  1. Q RGLOG
  1. ; Log time run completed
  1. STOP(RGQUIT) ;
  1. ;This entry point completes the logging process
  1. ; Input: required
  1. ; RGQUIT - 0 for success and 1 for failure
  1. ;
  1. Q:'$G(RGLOG)
  1. L +^RGHL7(991.1,RGLOG):10
  1. S DIE="^RGHL7(991.1,",DR="1.5///NOW;1.6///^S X=$G(RGQUIT)",DA=RGLOG D ^DIE K DIE,DA,DR
  1. L -^RGHL7(991.1,RGLOG)
  1. K RGLOG,RGQUIT,X,Y,DIC,DIE
  1. Q
  1. ; Log unclassified exception (old entry point)
  1. ERR(RGERR,RGSEV) ;
  1. D EXC(18,RGERR)
  1. S RGQUIT=$G(RGQUIT)!$G(RGSEV)
  1. Q
  1. ; Log an exception
  1. EXC(RGEXC,RGERR,RGDFN,MSGID,STATNUM) ;
  1. ;This entry point logs exceptions in the CIRN HL7 EXCEPTION LOG
  1. ;file (#991.1)
  1. ; Input: Required
  1. ; RGEXC - Exception type in File #991.11
  1. ; RGERR - Supplemental text
  1. ; Optional
  1. ; RGDFN - IEN in the PATIENT file (#2)
  1. ; MSGID - message id of the HL7 message where the exception was encountered (optional)
  1. ; STATNUM - station # of site that encountered the error (optional) - if not defined then the local site is assumed, using $$SITE^VASITE
  1. ;
  1. I (RGEXC=215)!(RGEXC=216)!(RGEXC=217) Q ;**52 until MPIFBT3 call eliminates these exception types
  1. ;I (RGEXC=215)!(RGEXC=216)!(RGEXC=217) Q ;**52 until MPIFBT3 call eliminates these exception types;**57 done in MPIF*1*52
  1. ; **62 (elz) MVI_4551, don't log 234 anymore
  1. I RGEXC=234 Q
  1. ;I RGEXC=234 N ACTPVR S ACTPVR=1 D I ACTPVR=0 Q ;**59 MVI_778 Do not log duplicate PVR (234) exception for patient if active one in CIRN HL7 EXCEPTION LOG (#991.1) file.
  1. ;.N PVRIEN,PVRIEN2 S PVRIEN=0
  1. ;.;Examine PVR (234) exception type, for patient - RGDFN
  1. ;.F S PVRIEN=$O(^RGHL7(991.1,"ADFN",234,RGDFN,PVRIEN)) Q:'PVRIEN Q:ACTPVR=0 D
  1. ;..S PVRIEN2=0
  1. ;..F S PVRIEN2=$O(^RGHL7(991.1,"ADFN",234,RGDFN,PVRIEN,PVRIEN2)) Q:'PVRIEN2 Q:ACTPVR=0 D
  1. ;...;Is there an active exception in CIRN HL7 EXCEPTION LOG (#991.1) file?
  1. ;...S ACTPVR=$P($G(^RGHL7(991.1,PVRIEN,1,PVRIEN2,0)),"^",5) I ACTPVR=0 Q
  1. ;
  1. I $L($G(HL("MID"))) Q:$$INVEXC(HL("MID")) ; is the exception valid?
  1. N RGI,RGZ
  1. S U="^"
  1. S:RGEXC[U RGERR=$P(RGEXC,U,2,999),RGEXC=+RGEXC
  1. S:RGEXC'=+RGEXC RGERR=RGEXC,RGEXC=18
  1. S:'$D(^RGHL7(991.11,RGEXC)) RGEXC=18
  1. L +^RGHL7(991.11,RGEXC):10
  1. S RGZ=$G(^RGHL7(991.11,RGEXC,0))
  1. S:$L(RGZ) $P(^RGHL7(991.11,RGEXC,0),U,5)=$P(RGZ,U,5)+1
  1. S:$P(RGZ,U,2)>1 RGQUIT=1
  1. L -^RGHL7(991.11,RGEXC)
  1. S RGLOG=$$CREATE
  1. L +^RGHL7(991.1,RGLOG):10
  1. S RGI=$O(^RGHL7(991.1,RGLOG,1,$C(32)),-1)+1
  1. S RGERR=$E($G(RGERR),1,250)
  1. S DIC="^RGHL7(991.1,"_RGLOG_",1,"
  1. S X=RGI,DA(1)=RGLOG,DIC(0)="FL",DLAYGO=991.12,DIC("P")=$P(^DD(991.1,2,0),"^",2)
  1. D ^DIC
  1. S DIE=DIC
  1. K DIC,DA,DR,DLAYGO
  1. S STAT=0
  1. S DIC="3.8",DIC(0)="Z",X="MPIF EXCEPTIONS" D ^DIC K DIC
  1. S RGMG=$P($G(Y),"^",1)
  1. I $P(^RGHL7(991.11,RGEXC,0),U,4)=RGMG S STAT=1
  1. S DA(1)=RGLOG,DA=RGI,DR="2///"_$G(RGEXC)_";3///"_$S($G(RGDFN):"`"_RGDFN,1:"")_";6///"_$G(STAT)_";10///"_$G(RGERR)
  1. D ^DIE K DIE,DA,DR
  1. L -^RGHL7(991.1,RGLOG)
  1. S RGI=$P(RGZ,U,3),RGZ=$P(RGZ,U,4)
  1. ;
  1. ;If the action type is for the MPI Exception Handler, send exception to the handler and quit
  1. I (RGI=3) D SENDMPI^RGHLLOG1($G(RGEXC),$G(RGERR),$G(RGDFN),$G(MSGID),$G(STATNUM)) Q
  1. ;
  1. Q:'RGI!'RGZ
  1. ;quit and don't send messages for exception types that are now being
  1. ;handled through the MPI/PD Exception Handling option.
  1. Q:RGEXC=234 ;**52 MPIC_772 remove 215, 216 & 217;**57 MPIC_1893 remove 218
  1. 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
  1. Q:RGZ=""!$P($G(^RGSITE("COR",1,0)),U,7)
  1. S RGERR=$$SHORT(RGEXC,RGERR),RGZ="G."_RGZ
  1. I RGI=2 D ALERT^RGRSUTL2(RGERR,RGZ) Q
  1. D MAIL^RGRSUTL2(RGERR,RGZ,"MPI/PD Exception: "_$$SHORT(RGEXC),"MPI/PD exception notification")
  1. Q
  1. ;
  1. INVEXC(RGMID) ; determine if this exception needs to be sent to MPI/PD
  1. ; personnel via FORUM. Return 1 to avoid messaging to FORUM, else 0.
  1. ; IA#:3244 is applied in this functionality
  1. N RGFLG,RGIEN S RGFLG=1
  1. S RGIEN=$$IEN773(RGMID) Q:'RGIEN RGFLG
  1. S RGIEN("SND")=$$GET1^DIQ(773,RGIEN_",",13)
  1. S RGIEN("REC")=$$GET1^DIQ(773,RGIEN_",",14)
  1. ; check the sending application (fld:13, 0;11) & the receiving
  1. ; application (fld:14, 0;12) to see if they are related to the MPI/PD
  1. ; project.
  1. I RGIEN("SND")]""!(RGIEN("REC")]"") D Q RGFLG
  1. .S RGFLG=$$APP(RGIEN("SND")) Q:'RGFLG
  1. .S RGFLG=$$APP(RGIEN("REC"))
  1. .Q
  1. ; Only if the sending/receiving applications cannot be determined from
  1. ; the data in their respective fields, do I check the MSH multiple for
  1. ; the MSH segment. I identify the sending/receiving application from
  1. ; this segment.
  1. E D
  1. .N RG,RG1,RGMSH,RGFS
  1. .D GETS^DIQ(773,RGIEN_",",200,,"RGMSH") ;check MSH mult for snd/rec app
  1. .Q:'($D(RGMSH)\10) ; no data in "MSH" multiple for file 773
  1. .S RGIEN=RGIEN_",",RG="RGMSH(773,"""_RGIEN_""","_200_")"
  1. .S RG1=0 F S RG1=$O(@RG@(RG1)) Q:RG1'>0 D Q:$E($G(@RG@(RG1)),1,3)="MSH"
  1. ..I $E($G(@RG@(RG1)),1,3)="MSH" D
  1. ...S RG(0)=$G(@RG@(RG1)),RGFS=$E(RG(0),4)
  1. ...S:$P(RG(0),RGFS,3)]"" RGFLG=$$APP($P(RG(0),RGFS,3)) Q:'RGFLG
  1. ...S:$P(RG(0),RGFS,5)]"" RGFLG=$$APP($P(RG(0),RGFS,5))
  1. ...Q
  1. ..Q
  1. .Q
  1. Q RGFLG
  1. APP(X) ; check if the sending/receiving application is relevant to the
  1. ; MPI/PD team. Returns 1 if a non-relevant namespace, else 0
  1. I $E(X,1,2)="RG"!($E(X,1,2)="VA")!($E(X,1,3)="MPI") Q 0
  1. Q 1
  1. ;
  1. IEN773(RGMID) ; find the ien of the record in the HL7 MESSAGE ADMINISTRATION
  1. ; (#773) file based on the Message ID. Input: Message ID
  1. ; Output: null, no record in 773, else 773 record ien. IA#: 3244
  1. Q:$G(RGMID)="" ""
  1. Q $O(^HLMA("C",RGMID,0))
  1. ;
  1. SHORT(RGEXC,RGTXT) ;
  1. ; Retrieve short text description of exception
  1. Q $G(^RGHL7(991.11,+RGEXC,10))_$S($G(RGTXT)="":"",1:": "_RGTXT)
  1. ;