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

MDCPVDEF.m

Go to the documentation of this file. 
  1. MDCPVDEF ;HINES OIFO/BJ/TJ - CP Outbound message record maintenance routine.;30 Jul 2007
  1.  ;;1.0;CLINICAL PROCEDURES;**16,12,23**;Apr 01, 2004;Build 281
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;  #10061       - IN5^VADPT                        Registration                   (supported)
  1.  ;  # 2817       - access "AD" x-ref per ^DG(40.8,  Registration     (controlled subscription)
  1.  ;  # 1373       - access ^ORD(101                  Kernel           (controlled subscription)
  1.  ;  #10039       - access ^DIC(42                   Registration                   (supported)
  1.  ;  # 1181       - access DGPM* event variables     Registration     (controlled subscription)
  1.  ;
  1.  ; only call via line tags.
  1.  Q
  1.  ;
  1. EN ;
  1.  ; Parses outbound message from PIMS to send to 3rd party devices via ADT/A?? message.
  1.  ;
  1.  ; Parameters -
  1.  ;   Covert (Preset local variables) -
  1.  ;     DFN - The internal entry number of the patient in file 2.
  1.  ;     DGPMDA - The movement internal entry number of the entry in the PATIENT_MOVEMENT
  1.  ;       file.
  1.  ;     DGPMA - Zero node of entry DGPMDA after the movement has been changed in the
  1.  ;       PATIENT MOVEMENT file.
  1.  ;     DGPMP - Zero node of entry DGPMDA before the movement has been changed in the
  1.  ;       PATIENT MOVEMENT file.
  1.  ;
  1.  ; Returns -
  1.  ;   None
  1.  ;
  1.  Q:'$D(DGPMA)&'$D(DGPMP)
  1.  N MDNODE,MDDIV,MDWARD,MDBED,MDEVNT,MDTYPE,MDDFN,MDMVMT,MDQUIT,MDDA,MDEDIT,VAIP
  1.  S MDNODE=$S(DGPMA]"":DGPMA,1:DGPMP)
  1.  S MDEDIT=(DGPMA]"")&(DGPMP]"")
  1.  S MDMVMT=DGPMDA
  1.  S MDDFN=$P(MDNODE,U,3)
  1.  S MDTYPE=+$P(MDNODE,U,2) Q:(MDTYPE'=MDTYPE\1)!(MDTYPE>3)!(MDTYPE<1)
  1.  S MDWARD=$P(MDNODE,U,6) I MDWARD=""  D LASTLOC(MDDFN,"WARD")
  1.  S MDBED=$P(MDNODE,U,7) I MDBED=""  D:MDTYPE'=1 LASTLOC(MDDFN,"BED")
  1.  I ($G(MDWARD)="")!($G(MDBED)="") Q  ;Q NOT inpatient activity 
  1.  ;
  1.  ; It appears that DIV might be empty if this is a single division facility.  So, we have to
  1.  ;   get a division of our own.
  1.  ;
  1.  S MDDIV=$P(^DIC(42,MDWARD,0),U,11)
  1.  I MDDIV="" S MDDIV=DUZ(2),MDDIV=$O(^DG(40.8,"AD",MDDIV,0))
  1.  ; Future inclusion: MD*1*23
  1.  ;I $G(^MDC(704.005,"APIMS",MDMVMT,MDDFN,MDWARD),0)&MDEDIT D RESEND^MDCPHL7C(MDDFN,MDDIV,MDWARD,MDBED,MDEDIT) Q  ; We've already seen this movement - Future A08
  1.  ;
  1.  ;   Movement         |  DGPMP      |   DGPMA
  1.  ;   ---------------------------------------------
  1.  ;   Admit            | Absent      |  Present
  1.  ;   Cancel Admit     | Present     |  Absent
  1.  ;   Transfer         | Absent      |  Present
  1.  ;   Cancel Xfer      | Present     |  Absent
  1.  ;   Discharge        | Absent      |  Present
  1.  ;   Cancel Discharge | Present     |  Absent
  1.  ;   Update           | Present old |  Present new
  1.  ;
  1.  S MDEVNT=$S(DGPMA]"":"A0",1:"A1")
  1.  S MDEVNT=MDEVNT_MDTYPE
  1.  W !,"Executing HL7 ADT Messaging (MD CP Flowsheets)",!
  1.  I '$$SENDMSG(MDDIV,MDWARD,"ADT",MDEVNT) W !,"No CP Flowsheets subscriber(s) for the movement location.",! Q
  1.  D ADD(MDDFN,MDDIV,MDWARD,$G(MDBED),"ADT",MDEVNT,MDMVMT)
  1.  Q
  1.  ;
  1. ADD(MDCPDFN,MDCPDIV,MDCPWARD,MDCPBED,MDCPMSG,MDCPEVNT,MDCPMVMT,MDCPROT) ;
  1.  ;
  1.  ; Adds information to CP_PATIENT_MOVEMENT file (704.005), and generates HL7 message.
  1.  ;
  1.  ; Parameters -
  1.  ;   Covert (Preset local variables) -
  1.  ;   None
  1.  ;
  1.  ;   Overt -
  1.  ;   MDCPDFN - The IFN of the patient in the PATIENT file.
  1.  ;   MDCPDIV - A pointer to the division of the ward for which the message was sent
  1.  ;   MDCPWARD - A pointer to the ward for which the movement was sent
  1.  ;   MDCPBED - A pointer to the bed for which the movement was sent
  1.  ;   MDCPMSG - The HL7 message type (at this point, this should ALWAYS be ADT).
  1.  ;   MDCPEVNT - The HL7 event type for the message (A01, A02, A03, etc.)
  1.  ;   MDCPMVMT - PATIENT MOVEMENT IEN (Stored as PIMS_EVENT_ID, not a pointer)
  1.  ;   MDCPROT  - Pointer to 704.006 (optional)
  1.  ;
  1.  ; Returns -
  1.  ;   None
  1.  ;
  1.  ; The first thing we want to do is see if this is a cancellation.  If it is, we need
  1.  ; to look back at the most recent previous movement in our system.  If the most recent
  1.  ; previous movement does NOT refer to the same division, ward, and bed, then we ignore
  1.  ; the event.
  1.  ;
  1.  ; $ESTACK, UNWIND^%ZTER, and ^%ZTER appear courtesy of IA 1621 (Supported)
  1.  ;
  1.  N MDCPDTTM
  1.  D NOW^%DTC S MDCPDTTM=%
  1.  N MDCPFLG S MDCPFLG=0
  1.  I MDCPEVNT?1"A1"1N D
  1.  .; The concept here is that, if this is a cancel movement, we need to take a look at
  1.  .; the most recent movement and cancellation of that movement type.  If there was another
  1.  .; cancel between the last movement and this cancel, we don't want to resend the message.
  1.  .N MDCPPREV,MDCPOLD,MDCPPOLD
  1.  .S MDCPOLD=$S(MDCPEVNT="A11":"A01",MDCPEVNT="A12":"A02",MDCPEVNT="A13":"A03",1:"")
  1.  .S MDCPPREV=$O(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPOLD,""),-1)
  1.  .S MDCPPOLD=$O(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPEVNT,""),-1)
  1.  .S MDCPFLG=$S(MDCPPREV="":"0",+MDCPPOLD'<+MDCPPREV:"1",1:"0")
  1.  ;
  1.  Q:MDCPFLG
  1.  N MDCFDA,MDCPIEN,MDCPPAIR
  1.  S MDCFDA(704.005,"+1,",.01)=MDCPDFN
  1.  S MDCFDA(704.005,"+1,",.02)=MDCPDTTM
  1.  S MDCFDA(704.005,"+1,",.03)=$G(MDCPDIV)
  1.  S MDCFDA(704.005,"+1,",.04)=$G(MDCPWARD)
  1.  S MDCFDA(704.005,"+1,",.05)=$G(MDCPBED)
  1.  S MDCFDA(704.005,"+1,",.06)=MDCPMSG
  1.  S MDCFDA(704.005,"+1,",.07)=MDCPEVNT
  1.  S MDCFDA(704.005,"+1,",.08)=$G(MDCPMVMT)
  1.  S MDCFDA(704.005,"+1,",.21)=$G(MDCPROT)
  1.  D UPDATE^DIE("","MDCFDA","MDCPIEN") Q:$G(MDCPIEN(1))<1
  1.  ;
  1.  I MDCPEVNT?1"A1"1N D
  1.  .S MDCPOLD=$S(MDCPEVNT="A11":"A01",MDCPEVNT="A12":"A02",MDCPEVNT="A13":"A03",1:"")
  1.  .N MDIFN,MDCPPREV
  1.  .S MDCPPREV=$O(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPOLD,""),-1)
  1.  .I MDCPPREV]"" D
  1.  ..S MDIFN=$O(^MDC(704.005,"LAST",MDCPDFN,MDCPMSG,MDCPOLD,MDCPPREV,""))
  1.  ..D DEL(MDIFN)
  1.  ;
  1.  N RETRN
  1.  K MDCFDA
  1.  S MDCFDA(704.005,MDCPIEN(1)_",",.09)=$$QUE^MDCPMESQ(MDCPIEN(1),MDCPEVNT,.RETRN) ; Queue message
  1.  S MDCFDA(704.005,MDCPIEN(1)_",",.1)=$G(RETRN,"No return message.")
  1.  D UPDATE^DIE("","MDCFDA")
  1.  Q
  1.  ;
  1. DEL(MDCPIFN) ;
  1.  ;
  1.  ; Removes entry from CP_PATIENT_MOVEMENT file (704.005).
  1.  ;
  1.  ; Parameters -
  1.  ;   Covert (Preset local variables) -
  1.  ;   None
  1.  ;
  1.  ;   Overt -
  1.  ;   MDCPIFN - IFN of entry in 704.005 to delete.
  1.  ;
  1.  ; Returns -
  1.  ;   None
  1.  ;
  1.  N MDCFDA
  1.  S MDCFDA(704.005,MDCPIFN_",",.01)="@"
  1.  D FILE^DIE("K","MDCFDA")
  1.  Q
  1.  ;
  1. GENDESTS ;
  1.  ; Filters outbound messages.  See HL*1.6*56/66 Site Manager and Developer Manual
  1.  ;   p. 11-7 to 11-11 (inc).
  1.  ;
  1.  ; IA's -
  1.  ;   1373 (provisional: subscription requested 3 Aug 2007)
  1.  ;
  1.  ; Parameters -
  1.  ;   Covert (Preset local variables) -
  1.  ;     HLNEXT - Executable code to retrieve the next line of an outbound HL7 message.
  1.  ;     HL("ECH") - Encoding characters for this HL7 message.
  1.  ;     HL("FS") - The Field Separator for this HL7 message.
  1.  ;     NAMEVAL - Local array passed from VDEF to HL7.  Must not be newed or killed.
  1.  ;
  1.  ;
  1.  ; Returns -
  1.  ;   None overt.  HLL("LINKS",n) will be read by HLO upon return.
  1.  ;
  1.  N MDCPV1,MDHLFS,MDHLECH,MDDIV,MDDIVI,MDWARD,MDWARDI,MDBED,MDCPSUB,MDCPROT,I,IEN
  1.  S IEN=MDCIEN
  1.  S MDHLFS=HL("FS")
  1.  S MDHLECH=$E(HL("ECH"),1,1)
  1.  F  X HLNEXT D  Q:HLQUIT'>0
  1.  .S:$P($G(HLNODE),MDHLFS)="PV1" MDCPV1=HLNODE
  1.  ; Division is PV1(3)(1), Room is PV1(3)(2), Bed is PV1(3)(3)
  1.  S MDDIV=$P(MDCPV1,MDHLFS,4)
  1.  S MDWARD=$P(MDDIV,MDHLECH,2)
  1.  S MDBED=$P(MDDIV,MDHLECH,3)
  1.  S MDDIVI=$P(^MDC(704.005,IEN,0),U,3)
  1.  S MDWARDI=$P(^MDC(704.005,IEN,0),U,4)
  1.  D ARRYDEST(MDDIVI,MDWARDI,$G(HL("MTN")),$G(HL("ETN")))
  1.  ;
  1.  Q
  1.  ;
  1. GETSUBS ;
  1.  ; Get subscriber protocols
  1.  ;
  1.  ; IA's -
  1.  ;   1373 (provisional, see above)
  1.  ;
  1.  ; Parameters -
  1.  ;   None
  1.  ;
  1.  ; Returns -
  1.  ;   Overt - None
  1.  ;
  1.  N Y S Y=0
  1.  F  S Y=$O(^ORD(101,Y)) Q:'Y  S:$P(^ORD(101,Y,0),U,4)="S"&($P(^(0),U,1)?1"MD".E) @MDROOT@(Y)=""
  1.  Q
  1.  ;
  1. GENDEST2(IEN) ; Filters outbound messages.  Unlike GENDESTS, this is set to filter
  1.  ;  assuming that we have not yet queued the outbound message.
  1.  ;
  1.  ;
  1.  ; Parameters
  1.  ;   IEN: The IEN of the entry in the CLIO_HL7_LOG file that will be used to generate
  1.  ;        this message.
  1.  ;
  1.  ; Returns -
  1.  ;   None overt.  HLL("LINKS",n) will be read by HLO upon return.
  1.  ;
  1.  N MDCPDIV,MDCPMSGT,MDCPEVNT
  1.  N MDCPMSG
  1.  D GETS^DIQ(704.005,IEN_",","*","I","MDCPMSG")
  1.  S MDCPDIV=$G(MDCPMSG("704.005",IEN_",",".03","I"))
  1.  S MDCPMSGT=$G(MDCPMSG("704.005",IEN_",",".06","I"))
  1.  S MDCPEVNT=$G(MDCPMSG("704.005",IEN_",",".07","I"))
  1.  S MDCPWARD=$G(MDCPMSG("704.005",IEN_",",".04","I"))
  1.  D ARRYDEST(MDCPDIV,MDCPWARD,MDCPMSGT,MDCPEVNT)
  1.  Q
  1.  ;
  1. ARRYDEST(DIVISION,WARD,MSGTYPE,EVNTTYPE) ;
  1.  ;
  1.  ; DIVISION: IEN of division in file 40.8.
  1.  ; WARD: IEN of ward in file 42.
  1.  ;
  1.  N MDCPSUB,I,MDCPROT,MDCPWARD
  1.  S MDCPSUB=0,I=0
  1.  F  S MDCPSUB=$O(^MDC(704.006,"LOCDEV",DIVISION,MDCPSUB)) Q:'MDCPSUB  D
  1.  .Q:MSGTYPE'=$P(^MDC(704.006,MDCPSUB,0),U,4)
  1.  .Q:EVNTTYPE'=$P(^MDC(704.006,MDCPSUB,0),U,5)
  1.  .S MDCPWARD=$P(^MDC(704.006,MDCPSUB,0),U,3)
  1.  .Q:(MDCPWARD'="")&(MDCPWARD'=WARD)
  1.  .S MDCPROT=$P(^MDC(704.006,MDCPSUB,0),U)
  1.  .S I=I+1
  1.  .S HLL("LINKS",I)=$P(^ORD(101,MDCPROT,0),U)_U_$$EXTERNAL^DILFD(101,770.7,"",$P(^ORD(101,MDCPROT,770),U,7))
  1.  Q
  1.  ;
  1. SENDMSG(DIVISION,WARD,MSGTYPE,EVNTTYPE) ;
  1.  ;
  1.  ; Determines whether or not we should continue to build or save this message.  On a basis
  1.  ;   of division, ward, message type, and event type, will return 1 or 0 based on whether or
  1.  ;   not there is an entry in 704.006 to send the message to a specific device.
  1.  ;
  1.  ; Parameters
  1.  ;   DIVISION - Division (internal)
  1.  ;   WARD - Ward (internal)
  1.  ;   MSGTYPE - HL7 message type  eg. "ADT"
  1.  ;   EVNTTYPE - HL7 event type   eg. "A01"
  1.  ;
  1.  ; Returns
  1.  ;   1 if message should be sent
  1.  ;   0 if not
  1.  ;
  1.  N USE
  1.  I $G(WARD)'="" D
  1.  .S USE=$O(^MDC(704.006,"AMSGDIVWARD",MSGTYPE,EVNTTYPE,$G(DIVISION),$G(WARD),0))
  1.  I $G(WARD)="" D
  1.  .N WD S WD=0 S USE=0
  1.  .F  S WD=$O(^MDC(704.006,"AMSGDIV",MSGTYPE,EVNTTYPE,$G(DIVISION),WD)) Q:+WD=0  D
  1.  ..I $P(^MDC(704.006,WD,0),U,3)="" S USE=1 Q
  1.  Q:+$G(USE) 1
  1.  Q 0
  1.  ;
  1. LASTLOC(MDCPDFN,MDCPLOC) ;
  1.  ;
  1.  ; Retrieve inpatient's location via LAST known LOCation per CP  - if neccessary ....
  1.  ;
  1.  ; Parameters
  1.  ;   MDCPDFN - Patient's IEN
  1.  ;   MDCPLOC - "WARD" or "BED" (seeking ward or bed data)
  1.  ;
  1.  ; Returns
  1.  ;   1 if found location patient
  1.  ;   0 if NOT found location of patient or NOT INPATIENT
  1.  ;  
  1.  N LASTLOC S LASTLOC=""
  1. A02 ;Look into transfers (A02)
  1.  G:'$D(^MDC(704.005,"LAST",MDCPDFN,"ADT","A02")) A01
  1.  N MDCDAT S MDCDAT=$O(^MDC(704.005,"LAST",MDCPDFN,"ADT","A02",""),-1)
  1.  S LASTLOC=$O(^MDC(704.005,"LAST",MDCPDFN,"ADT","A02",MDCDAT,LASTLOC))
  1.  I LASTLOC]"" D  Q
  1.   .I MDCPLOC="WARD" S MDWARD=$P(^MDC(704.005,LASTLOC,0),U,4)
  1.   .I MDCPLOC="BED" S MDBED=$P(^MDC(704.005,LASTLOC,0),U,5)
  1. A01 ;Look into admissions (A01)
  1.  ;
  1.  G:'$D(^MDC(704.005,"LAST",MDCPDFN,"ADT","A01")) VADATA
  1.  N MDCDAT S MDCDAT=$O(^MDC(704.005,"LAST",MDCPDFN,"ADT","A01",""),-1)
  1.  S LASTLOC=$O(^MDC(704.005,"LAST",MDCPDFN,"ADT","A01",MDCDAT,LASTLOC))
  1.  I LASTLOC]"" D  Q
  1.   .I MDCPLOC="WARD" S MDWARD=$P(^MDC(704.005,LASTLOC,0),U,4)
  1.   .I MDCPLOC="BED" S MDBED=$P(^MDC(704.005,LASTLOC,0),U,5)
  1. VADATA ;Look into VADPT 
  1.  N DFN S DFN=MDCPDFN
  1.  S:MDTYPE=3 VAIP("D")=$P(MDNODE,".")
  1.  D IN5^VADPT
  1.  I MDCPLOC="WARD" S MDWARD=$P(VAIP(5),U)
  1.  I MDCPLOC="BED" S MDBED=$P(VAIP(6),U)
  1.  Q