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

GMRCIACT.m

Go to the documentation of this file. 
  1. GMRCIACT ;SLC/JFR - PROCESS ACTIONS ON IFC ;02/10/02 22:13
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**22,47,58**;DEC 27, 1997;Build 4
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q  ;don't start here!
  1. NW(ARRAY) ;process and file new order
  1.  ;Input:
  1.  ; ARRAY  = name of array containing message parts
  1.  ;
  1.  N GMRCFDA,GMRCORC,GMRCDA,GMRCITM,GMRCITER,GMRCROUT,GMRCFCN,GMRCLAC
  1.  K ^TMP("GMRCIN",$J)
  1.  M ^TMP("GMRCIN",$J)=@ARRAY
  1.  S GMRCORC=^TMP("GMRCIN",$J,"ORC")
  1.  D  I $D(GMRCITER) Q  ;Check for order already being on file
  1.  . S GMRCFCN=+$P(GMRCORC,"|",2)
  1.  . S GMRCROUT=$$IEN^XUAF4($P($P(GMRCORC,"|",2),U,2))
  1.  . I '$O(^GMR(123,"AIFC",GMRCROUT,GMRCFCN,0)) Q  ;no dup
  1.  . S GMRCITER=802
  1.  . D APPACK^GMRCIAC2(0,"AR",GMRCITER) ;send app. ack w/ error
  1.  . K ^TMP("GMRCIN",$J) Q 
  1.  I '$D(^TMP("GMRCIN",$J,"PID")) Q  ;prepare reject message (no PID)
  1.  D  ;get patient DFN from ICN in message
  1.  . N PAT
  1.  . S PAT=$$GETDFN^MPIF001(+$P(^TMP("GMRCIN",$J,"PID"),"|",2))
  1.  . I +PAT'>1 S GMRCFDA(.02)="" Q
  1.  . S GMRCFDA(.02)=+PAT
  1.  I '$G(GMRCFDA(.02)) D  Q  ;reject message, patient is unknown
  1.  . N STA S STA=$P($P(^TMP("GMRCIN",$J,"ORC"),"|",2),U,2)
  1.  . N OBR S OBR=^TMP("GMRCIN",$J,"OBR")
  1.  . D PTERRMSG^GMRCIERR(^TMP("GMRCIN",$J,"PID"),STA,,OBR)
  1.  . D APPACK^GMRCIAC2(0,"AR",201) ; send app. ack w/error
  1.  . K ^TMP("GMRCIN",$J) Q 
  1.  D  ;get ordered item and service
  1.  . S GMRCITM=$P(^TMP("GMRCIN",$J,"OBR"),"|",4)
  1.  . I GMRCITM["VA1233" D  ; proc
  1.  .. N PROC
  1.  .. S PROC=$$GETPROC^GMRCIUTL(GMRCITM)
  1.  .. I +PROC'>0!('$P(PROC,U,2)) S GMRCITER=$P(PROC,U,3) Q
  1.  .. S GMRCFDA(4)=$P(PROC,U)_";GMR(123.3,"
  1.  .. S GMRCFDA(1)=$P(PROC,U,2)
  1.  . I GMRCITM["VA1235" D
  1.  .. N SERV
  1.  .. S SERV=$$GETSERV^GMRCIUTL(GMRCITM) ;consult
  1.  .. I +SERV'>0 S GMRCITER=$P(SERV,U,3)
  1.  .. S GMRCFDA(1)=SERV
  1.  I $D(GMRCITER) D  Q  ;error in procedure or service, reject new order
  1.  . D APPACK^GMRCIAC2(0,"AR",GMRCITER) ; send app. ACK
  1.  . K ^TMP("GMRCIN",$J) Q
  1.  ;
  1.  S GMRCFDA(.01)=$$NOW^XLFDT
  1.  S GMRCFDA(3)=$$HL7TFM^XLFDT($P(GMRCORC,"|",15))
  1.  S GMRCFDA(6)=$$FIND1^DIC(101,"","X","GMRCPLACE - ON CALL")
  1.  D  ;get urgency to file
  1.  . N URG
  1.  . S URG=$$URG^GMRCHL7A($P($P(GMRCORC,"|",7),U,6))
  1.  . S GMRCFDA(5)=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_URG)
  1.  S GMRCFDA(8)=5
  1.  S GMRCFDA(9)=$S($P(GMRCORC,"|",16)["FI":24,1:23),GMRCLAC=GMRCFDA(9)
  1.  S GMRCFDA(14)=$P(^TMP("GMRCIN",$J,"OBR"),"|",18)
  1.  S GMRCFDA(.05)=$$IEN^XUAF4(+$P(GMRCORC,"|",17))
  1.  S GMRCFDA(.06)=GMRCFCN
  1.  S GMRCFDA(.07)=GMRCROUT
  1.  D  ;get and set ordering prov info & entering person info
  1.  . N GMRCOP
  1.  . S GMRCOP=$$FMNAME^XLFNAME($P(GMRCORC,"|",12))
  1.  . Q:'$L(GMRCOP)
  1.  . S GMRCFDA(.126)=GMRCOP
  1.  . Q
  1.  S GMRCFDA(.125)="F"
  1.  I $L($P(GMRCORC,"|",14)) D
  1.  . N GMRCP14 S GMRCP14=$P(GMRCORC,"|",14)
  1.  . S GMRCFDA(.132)=$P(GMRCP14,"B") ; requestor's phone number
  1.  . S GMRCFDA(.133)=$P(GMRCP14,"B",2) ; requestor's dig pager
  1.  S GMRCFDA(13)=$S($D(GMRCFDA(4)):"P",1:"C")
  1.  I $D(^TMP("GMRCIN",$J,"OBX",2)) D
  1.  . S GMRCFDA(30)=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U,2)
  1.  . S GMRCFDA(30.1)=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U)
  1.  M FDA(1,123,"+1,")=GMRCFDA
  1.  D UPDATE^DIE("","FDA(1)","GMRCDA","GMRCERR")
  1.  I '$D(GMRCDA) D  Q  ;couldn't get new consult #
  1.  . D APPACK^GMRCIAC2(0,"AR",901) ; send app. ACK
  1.  . K ^TMP("GMRCIN",$J) Q
  1.  K GMRCFDA,FDA
  1.  D  ; file reason for request
  1.  . D TRIMWP^GMRCIUTL($NA(^TMP("GMRCIN",$J,"OBX",1)),5)
  1.  . D WP^DIE(123,GMRCDA(1)_",",20,"K",$NA(^TMP("GMRCIN",$J,"OBX",1)))
  1.  . Q
  1.  D  ;file activity tracking
  1.  . N GMRCSEG
  1.  . S GMRCSEG("ORC")=GMRCORC
  1.  . S GMRCSEG("OBX",5,1)=^TMP("GMRCIN",$J,"OBX",5,1)
  1.  . D FILEACT^GMRCIAC2(GMRCDA(1),GMRCLAC,,"GMRCSEG")
  1.  D  ;print SF-513
  1.  . I GMRCLAC=24 Q  ;don't print if part of a FWD to IFC
  1.  . D PRNT^GMRCUTL1("",GMRCDA(1))
  1.  D  ;send notifications
  1.  . I GMRCLAC=24 Q  ;no alerts yet if part of FWD to IFC
  1.  . N GMRCORTX
  1.  . S GMRCORTX="New remotely ordered consult "_$$ORTX^GMRCAU(+GMRCDA(1))
  1.  . D MSG^GMRCP($P(^GMR(123,GMRCDA(1),0),U,2),GMRCORTX,GMRCDA(1),27,,1)
  1.  D  ;send appl ack :-(
  1.  . N GMRCRSLT
  1.  . D RESP^GMRCIUTL("AA",HL("MID"),$P(GMRCORC,"|"),GMRCDA(1))
  1.  . D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT)
  1.  K ^TMP("GMRCIN",$J)
  1.  Q
  1.  ;
  1. DIS(GMRCAR) ;dis-associate a result from a remote request
  1.  ;Input:
  1.  ; GMRCAR = array name containing message 
  1.  ;      e.g.  ^TMP("GMRCIF",$J)
  1.  N GMRCDA,GMRCFDA,FDA,GMRCERR,GMRCORC
  1.  M ^TMP("GMRCID",$J)=@GMRCAR
  1.  S GMRCORC=^TMP("GMRCID",$J,"ORC")
  1.  S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
  1.  I '$$LOCKREC^GMRCUTL1(GMRCDA) D  Q  ;couldn't lock record
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ;send app. ACK
  1.  . K ^TMP("GMRCID",$J) Q
  1.  ;    v--check to see if a dup transmission
  1.  I $$DUPACT^GMRCIAC2(GMRCDA,12,GMRCORC,^TMP("GMRCID",$J,"OBX",4,1)) Q
  1.  ;
  1.  D FILEACT^GMRCIAC2(GMRCDA,12,,$NA(^TMP("GMRCID",$J))) ; act. tracking
  1.  D FILRES^GMRCIAC2(GMRCDA,^TMP("GMRCID",$J,"OBX",4,1)) ;file results
  1.  K GMRCERR,FDA,GMRCFDA
  1.  I $$STSCHG^GMRCDIS(GMRCDA) S FDA(1,123,GMRCDA_",",8)=6
  1.  S FDA(1,123,GMRCDA_",",9)=12
  1.  D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and status
  1.  D  ;send notifications
  1.  . I $P(^GMR(123,GMRCDA,12),U,5)="F" Q  ;DIS from placer before IFC
  1.  . N GMRCORTX
  1.  . S GMRCORTX="Remote result removed from "_$$ORTX^GMRCAU(+GMRCDA)
  1.  . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,63,,1)
  1.  D  ;send appl ACK
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AA") ; send app. ACK and unlock record
  1.  K ^TMP("GMRCID",$J)
  1.  Q
  1.  ;
  1. OTHER(GMRCAR) ;process most IFC actions
  1.  ;will process the receive, schedule, DC, cancel and added comment action
  1.  ;
  1.  ;Input:
  1.  ; GMRCAR = array name containing message 
  1.  ;      e.g.  ^TMP("GMRCIF",$J)
  1.  ;
  1.  N GMRCDA,GMRCFDA,GMRCORC,GMRCLAT,GMRCACT,GMRCROL,FDA
  1.  K ^TMP("GMRCIN",$J)
  1.  M ^TMP("GMRCIN",$J)=@GMRCAR
  1.  ;
  1.  S GMRCORC=^TMP("GMRCIN",$J,"ORC")
  1.  S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)  ;get ien to work on 
  1.  S GMRCROL=$P(^GMR(123,GMRCDA,12),U,5)
  1.  I '$$LOCKREC^GMRCUTL1(GMRCDA) D  Q  ;couldn't lock record
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AR",901) ; send app. ACK
  1.  . K ^TMP("GMRCIN",$J) Q
  1.  ;
  1.  I $P(GMRCORC,"|")'="IP" D  ; status update
  1.  . N GMRCOS S GMRCOS=$P(GMRCORC,"|",5)
  1.  . S GMRCFDA(8)=$S(GMRCOS="IP":6,GMRCOS="SC":8,GMRCOS="CA":13,1:1)
  1.  . ; IP=receive, SC=schedule, CA=cancel, DC=discontinue
  1.  D  ; get last action taken
  1.  . I '$G(GMRCFDA(8)) S (GMRCFDA(9),GMRCLAT)=20 Q
  1.  . I GMRCFDA(8)=6 S (GMRCFDA(9),GMRCLAT)=21 Q
  1.  . I GMRCFDA(8)=8 S (GMRCFDA(9),GMRCLAT)=8 Q
  1.  . I GMRCFDA(8)=1 S (GMRCFDA(9),GMRCLAT)=6 Q
  1.  . I GMRCFDA(8)=13 S (GMRCFDA(9),GMRCLAT)=19 Q
  1.  ;                         ^--last action taken
  1.  ;    v-- check to see if a dup transmission
  1.  I $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAT,GMRCORC) Q
  1.  ;
  1.  M FDA(1,123,GMRCDA_",")=GMRCFDA
  1.  D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and update status
  1.  K GMRCFDA
  1.  D FILEACT^GMRCIAC2(GMRCDA,GMRCLAT,,$NA(^TMP("GMRCIN",$J)))
  1.  D  ;send notifications
  1.  . N GMRCTX,GMRCNOT,GMRCFL
  1.  . S GMRCFL=1
  1.  . I GMRCLAT=20!(GMRCLAT=8)!(GMRCLAT=21) D
  1.  .. I GMRCLAT=20 D  I '$D(GMRCTX) Q
  1.  ... I $P(^GMR(123,GMRCDA,40,1,0),U,2)'=24 D  Q
  1.  .... S GMRCTX="Comment Added to remote"
  1.  ... N ACT S ACT=1
  1.  ... F  S ACT=$O(^GMR(123,GMRCDA,40,ACT)) Q:'ACT!($D(GMRCTX))  D
  1.  .... I $P(^GMR(123,GMRCDA,40,ACT,0),U,2)=25,$O(^GMR(123,GMRCDA,40,ACT)) D
  1.  ..... S GMRCTX="Comment Added to remote"
  1.  .. I '$D(GMRCTX),GMRCROL="F" Q  ;sch & rec on filler part of FWD 2 IFC
  1.  .. I GMRCLAT=8 S GMRCTX="Scheduled remote"
  1.  .. I GMRCLAT=21 S GMRCTX="Received remote"
  1.  .. S GMRCTX=GMRCTX_" Consult: "_$$ORTX^GMRCAU(+GMRCDA)
  1.  .. S GMRCNOT=63
  1.  . I GMRCLAT=6 D
  1.  .. S GMRCFL=$$DCNOTE^GMRCADC(GMRCDA,.5)
  1.  .. S GMRCTX="Discontinued remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
  1.  .. S GMRCNOT=23
  1.  . I GMRCLAT=19 D
  1.  .. I GMRCROL="F" Q  ;canc on a filler is part of FWD 2 IFC
  1.  .. S GMRCTX="Cancelled remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
  1.  .. S GMRCNOT=30
  1.  . I '$D(GMRCNOT) Q  ;don't send any alerts
  1.  . D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,GMRCNOT,,GMRCFL)
  1.  ;
  1.  D  ;send appl ACK
  1.  . D APPACK^GMRCIAC2(GMRCDA,"AA") ;send app. ACK and unlock record
  1.  K ^TMP("GMRCIN",$J)
  1.  Q
  1.  ;