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

GMRCIEV1.m

Go to the documentation of this file.
  1. GMRCIEV1 ;SLC/JFR - IFC EVENTS CONT'D ;01/27/03 09:28
  1. ;;3.0;CONSULT/REQUEST TRACKING;**22,28,31**;DEC 27, 1997
  1. Q ;no-no-no
  1. RESUB(GMRCDA,GMRCACT) ;build HL7 msg with edits from resubit
  1. ;Input:
  1. ; GMRCDA = ien from file 123
  1. ; GMRCACT = ien of the activity from 40 multiple
  1. ;
  1. N HL,HLL,SEG,GMRC773,GMRCIQT
  1. S SEG=1
  1. K ^TMP("HLS",$J)
  1. D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
  1. I $G(HL) D Q ; if HL array can't be built, log it with an error
  1. . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
  1. D I $D(GMRCIQT) D NOMPI^GMRCIEVT(GMRCDA,GMRCACT) Q ;build PID seg
  1. . N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
  1. . I '$G(GMRCDFN) S GMRCIQT=1 Q
  1. . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
  1. . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
  1. . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
  1. . S SEG=SEG+1
  1. . Q
  1. ;
  1. ;build ORC seg based on GMRCACT
  1. S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,"XO","IP",GMRCACT)
  1. S SEG=SEG+1
  1. ;
  1. ; include Inpatient or Outpatient
  1. S ^TMP("HLS",$J,SEG)=$$OBR^GMRCISG1(GMRCDA,GMRCACT)
  1. S SEG=SEG+1
  1. ;
  1. D ;load up reason for request
  1. . K ^TMP("GMRCRFR",$J)
  1. . D OBXWP^GMRCISEG(GMRCDA,"XO",GMRCACT,$NA(^TMP("GMRCRFR",$J)))
  1. . I '$D(^TMP("GMRCRFR",$J)) Q
  1. . N I S I=0
  1. . F S I=$O(^TMP("GMRCRFR",$J,I)) Q:'I D
  1. .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCRFR",$J,I)
  1. .. S SEG=SEG+1
  1. . K ^TMP("GMRCRFR",$J)
  1. . Q
  1. D ;prov DX changed, send it
  1. . S ^TMP("HLS",$J,SEG)=$$OBXPD^GMRCISG1(GMRCDA)
  1. . S SEG=SEG+1
  1. ;
  1. D ;send ed-res comment and file as is
  1. . N I
  1. . K ^TMP("GMRCMT",$J)
  1. . D OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J)))
  1. . Q:'$O(^TMP("GMRCMT",$J,0))
  1. . S I=0 F S I=$O(^TMP("GMRCMT",$J,I)) Q:'I D
  1. .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCMT",$J,I)
  1. .. S SEG=SEG+1
  1. . K ^TMP("GMRCMT",$J)
  1. . Q
  1. S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
  1. S HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA) I '$L(HLL("LINKS",1)) D Q
  1. . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error
  1. D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
  1. N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
  1. D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
  1. Q
  1. ;
  1. SF(GMRCDA,GMRCACT) ;send SIG FINDING update
  1. ;Input:
  1. ; GMRCDA = ien from file 123
  1. ; GMRCACT = ien of the activity from 40 multiple
  1. N HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS
  1. S SEG=1
  1. K ^TMP("HLS",$J)
  1. D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
  1. I $G(HL) D Q ; if HL array can't be built, log it with an error
  1. . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
  1. D I $D(GMRCIQT) D NOMPI^GMRCIEVT(GMRCDA,GMRCACT) Q ;build PID seg
  1. . N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
  1. . I '$G(GMRCDFN) S GMRCIQT=1 Q
  1. . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
  1. . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
  1. . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
  1. . S SEG=SEG+1
  1. . Q
  1. ;
  1. ;build ORC seg based on GMRCACT
  1. S GMRCOS=$S($P(^GMR(123,GMRCDA,0),U,12)="2":"CM",1:"IP")
  1. S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,"RE","CM",GMRCACT)
  1. S SEG=SEG+1
  1. I $O(^GMR(123,GMRCDA,40,GMRCACT,1,0)) D ;load up comment to send
  1. . K ^TMP("GMRCMT",$J)
  1. . D OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J)))
  1. . Q:'$O(^TMP("GMRCMT",$J,0))
  1. . N I S I=0 F S I=$O(^TMP("GMRCMT",$J,I)) Q:'I D
  1. .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCMT",$J,I)
  1. .. S SEG=SEG+1
  1. . K ^TMP("GMRCMT",$J)
  1. . Q
  1. S ^TMP("HLS",$J,SEG)=$$OBXSF^GMRCISEG(GMRCDA),SEG=SEG+1
  1. S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
  1. S HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA) I '$L(HLL("LINKS",1)) D Q
  1. . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error
  1. D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
  1. N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
  1. D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
  1. Q
  1. ;
  1. FWD(GMRCDA,GMRCACT) ;bld HL7 msg upon FWD action
  1. ;Input:
  1. ; GMRCDA = ien from file 123
  1. ; GMRCACT = ien of the activity from 40 multiple
  1. N HL,HLL,SEG,GMRC773,GMRCIQT,GMRCOS
  1. S SEG=1
  1. K ^TMP("HLS",$J)
  1. D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
  1. I $G(HL) D Q ; if HL array can't be built, log it with an error
  1. . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,,904)
  1. D I $D(GMRCIQT) D NOMPI^GMRCIEVT(GMRCDA,GMRCACT) Q ;build PID seg
  1. . N GMRCDFN S GMRCDFN=$P(^GMR(123,+GMRCDA,0),U,2)
  1. . I '$G(GMRCDFN) S GMRCIQT=1 Q
  1. . I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
  1. . I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
  1. . S ^TMP("HLS",$J,SEG)=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
  1. . S SEG=SEG+1
  1. . Q
  1. ;
  1. ;build ORC seg based on GMRCACT
  1. S ^TMP("HLS",$J,SEG)=$$ORC^GMRCISEG(GMRCDA,"XX","IP",GMRCACT)
  1. S SEG=SEG+1
  1. S ^TMP("HLS",$J,SEG)=$$OBR^GMRCISG1(GMRCDA,GMRCACT),SEG=SEG+1
  1. I $O(^GMR(123,GMRCDA,40,GMRCACT,1,0)) D ;load up comment to send
  1. . K ^TMP("GMRCMT",$J)
  1. . D OBXWP^GMRCISEG(GMRCDA,"",GMRCACT,$NA(^TMP("GMRCMT",$J)))
  1. . Q:'$O(^TMP("GMRCMT",$J,0))
  1. . N I S I=0 F S I=$O(^TMP("GMRCMT",$J,I)) Q:'I D
  1. .. S ^TMP("HLS",$J,SEG)=^TMP("GMRCMT",$J,I)
  1. .. S SEG=SEG+1
  1. . K ^TMP("GMRCMT",$J)
  1. . Q
  1. S ^TMP("HLS",$J,SEG)=$$OBXSF^GMRCISEG(GMRCDA),SEG=SEG+1
  1. S ^TMP("HLS",$J,SEG)=$$OBXTZ^GMRCISEG ;always include local time zone
  1. S HLL("LINKS",1)=$$ROUTE^GMRCIEVT(GMRCDA) I '$L(HLL("LINKS",1)) D Q
  1. . D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,"",903) ;log error
  1. D GENERATE^HLMA("GMRC IFC ORM EVENT","GM",1,.GMRC773)
  1. N ERR S ERR=$S($P(GMRC773,U,2):904,1:"") ; if err from HL7, log it
  1. D LOGMSG^GMRCIUTL(GMRCDA,GMRCACT,+GMRC773,ERR)
  1. Q
  1. ;
  1. FWD2IFC(GMRCDA,GMRCACT) ;pkg up and send request upon fwd'ing into IFC serv
  1. ;Input:
  1. ; GMRCDA = ien from file 123
  1. ; GMRCACT = ien of the activity from 40 multiple
  1. N GMRCACTN
  1. I '$P(^GMR(123,GMRCDA,0),U,22),'$D(^GMR(123.6,"C",GMRCDA)) D Q
  1. . D NW^GMRCIEVT(GMRCDA)
  1. . S GMRCACTN=1
  1. . F S GMRCACTN=$O(^GMR(123,GMRCDA,40,GMRCACTN)) Q:'GMRCACTN D
  1. .. D TRIGR^GMRCIEVT(GMRCDA,GMRCACTN)
  1. D FWD(GMRCDA,GMRCACT)
  1. Q