GMRCIACT ;SLC/JFR - PROCESS ACTIONS ON IFC ;02/10/02 22:13
;;3.0;CONSULT/REQUEST TRACKING;**22,47,58**;DEC 27, 1997;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
Q ;don't start here!
NW(ARRAY) ;process and file new order
;Input:
; ARRAY = name of array containing message parts
;
N GMRCFDA,GMRCORC,GMRCDA,GMRCITM,GMRCITER,GMRCROUT,GMRCFCN,GMRCLAC
K ^TMP("GMRCIN",$J)
M ^TMP("GMRCIN",$J)=@ARRAY
S GMRCORC=^TMP("GMRCIN",$J,"ORC")
D I $D(GMRCITER) Q ;Check for order already being on file
. S GMRCFCN=+$P(GMRCORC,"|",2)
. S GMRCROUT=$$IEN^XUAF4($P($P(GMRCORC,"|",2),U,2))
. I '$O(^GMR(123,"AIFC",GMRCROUT,GMRCFCN,0)) Q ;no dup
. S GMRCITER=802
. D APPACK^GMRCIAC2(0,"AR",GMRCITER) ;send app. ack w/ error
. K ^TMP("GMRCIN",$J) Q
I '$D(^TMP("GMRCIN",$J,"PID")) Q ;prepare reject message (no PID)
D ;get patient DFN from ICN in message
. N PAT
. S PAT=$$GETDFN^MPIF001(+$P(^TMP("GMRCIN",$J,"PID"),"|",2))
. I +PAT'>1 S GMRCFDA(.02)="" Q
. S GMRCFDA(.02)=+PAT
I '$G(GMRCFDA(.02)) D Q ;reject message, patient is unknown
. N STA S STA=$P($P(^TMP("GMRCIN",$J,"ORC"),"|",2),U,2)
. N OBR S OBR=^TMP("GMRCIN",$J,"OBR")
. D PTERRMSG^GMRCIERR(^TMP("GMRCIN",$J,"PID"),STA,,OBR)
. D APPACK^GMRCIAC2(0,"AR",201) ; send app. ack w/error
. K ^TMP("GMRCIN",$J) Q
D ;get ordered item and service
. S GMRCITM=$P(^TMP("GMRCIN",$J,"OBR"),"|",4)
. I GMRCITM["VA1233" D ; proc
.. N PROC
.. S PROC=$$GETPROC^GMRCIUTL(GMRCITM)
.. I +PROC'>0!('$P(PROC,U,2)) S GMRCITER=$P(PROC,U,3) Q
.. S GMRCFDA(4)=$P(PROC,U)_";GMR(123.3,"
.. S GMRCFDA(1)=$P(PROC,U,2)
. I GMRCITM["VA1235" D
.. N SERV
.. S SERV=$$GETSERV^GMRCIUTL(GMRCITM) ;consult
.. I +SERV'>0 S GMRCITER=$P(SERV,U,3)
.. S GMRCFDA(1)=SERV
I $D(GMRCITER) D Q ;error in procedure or service, reject new order
. D APPACK^GMRCIAC2(0,"AR",GMRCITER) ; send app. ACK
. K ^TMP("GMRCIN",$J) Q
;
S GMRCFDA(.01)=$$NOW^XLFDT
S GMRCFDA(3)=$$HL7TFM^XLFDT($P(GMRCORC,"|",15))
S GMRCFDA(6)=$$FIND1^DIC(101,"","X","GMRCPLACE - ON CALL")
D ;get urgency to file
. N URG
. S URG=$$URG^GMRCHL7A($P($P(GMRCORC,"|",7),U,6))
. S GMRCFDA(5)=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_URG)
S GMRCFDA(8)=5
S GMRCFDA(9)=$S($P(GMRCORC,"|",16)["FI":24,1:23),GMRCLAC=GMRCFDA(9)
S GMRCFDA(14)=$P(^TMP("GMRCIN",$J,"OBR"),"|",18)
S GMRCFDA(.05)=$$IEN^XUAF4(+$P(GMRCORC,"|",17))
S GMRCFDA(.06)=GMRCFCN
S GMRCFDA(.07)=GMRCROUT
D ;get and set ordering prov info & entering person info
. N GMRCOP
. S GMRCOP=$$FMNAME^XLFNAME($P(GMRCORC,"|",12))
. Q:'$L(GMRCOP)
. S GMRCFDA(.126)=GMRCOP
. Q
S GMRCFDA(.125)="F"
I $L($P(GMRCORC,"|",14)) D
. N GMRCP14 S GMRCP14=$P(GMRCORC,"|",14)
. S GMRCFDA(.132)=$P(GMRCP14,"B") ; requestor's phone number
. S GMRCFDA(.133)=$P(GMRCP14,"B",2) ; requestor's dig pager
S GMRCFDA(13)=$S($D(GMRCFDA(4)):"P",1:"C")
I $D(^TMP("GMRCIN",$J,"OBX",2)) D
. S GMRCFDA(30)=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U,2)
. S GMRCFDA(30.1)=$P($P(^TMP("GMRCIN",$J,"OBX",2,1),"|",5),U)
M FDA(1,123,"+1,")=GMRCFDA
D UPDATE^DIE("","FDA(1)","GMRCDA","GMRCERR")
I '$D(GMRCDA) D Q ;couldn't get new consult #
. D APPACK^GMRCIAC2(0,"AR",901) ; send app. ACK
. K ^TMP("GMRCIN",$J) Q
K GMRCFDA,FDA
D ; file reason for request
. D TRIMWP^GMRCIUTL($NA(^TMP("GMRCIN",$J,"OBX",1)),5)
. D WP^DIE(123,GMRCDA(1)_",",20,"K",$NA(^TMP("GMRCIN",$J,"OBX",1)))
. Q
D ;file activity tracking
. N GMRCSEG
. S GMRCSEG("ORC")=GMRCORC
. S GMRCSEG("OBX",5,1)=^TMP("GMRCIN",$J,"OBX",5,1)
. D FILEACT^GMRCIAC2(GMRCDA(1),GMRCLAC,,"GMRCSEG")
D ;print SF-513
. I GMRCLAC=24 Q ;don't print if part of a FWD to IFC
. D PRNT^GMRCUTL1("",GMRCDA(1))
D ;send notifications
. I GMRCLAC=24 Q ;no alerts yet if part of FWD to IFC
. N GMRCORTX
. S GMRCORTX="New remotely ordered consult "_$$ORTX^GMRCAU(+GMRCDA(1))
. D MSG^GMRCP($P(^GMR(123,GMRCDA(1),0),U,2),GMRCORTX,GMRCDA(1),27,,1)
D ;send appl ack :-(
. N GMRCRSLT
. D RESP^GMRCIUTL("AA",HL("MID"),$P(GMRCORC,"|"),GMRCDA(1))
. D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT)
K ^TMP("GMRCIN",$J)
Q
;
DIS(GMRCAR) ;dis-associate a result from a remote request
;Input:
; GMRCAR = array name containing message
; e.g. ^TMP("GMRCIF",$J)
N GMRCDA,GMRCFDA,FDA,GMRCERR,GMRCORC
M ^TMP("GMRCID",$J)=@GMRCAR
S GMRCORC=^TMP("GMRCID",$J,"ORC")
S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
I '$$LOCKREC^GMRCUTL1(GMRCDA) D Q ;couldn't lock record
. D APPACK^GMRCIAC2(GMRCDA,"AR",901) ;send app. ACK
. K ^TMP("GMRCID",$J) Q
; v--check to see if a dup transmission
I $$DUPACT^GMRCIAC2(GMRCDA,12,GMRCORC,^TMP("GMRCID",$J,"OBX",4,1)) Q
;
D FILEACT^GMRCIAC2(GMRCDA,12,,$NA(^TMP("GMRCID",$J))) ; act. tracking
D FILRES^GMRCIAC2(GMRCDA,^TMP("GMRCID",$J,"OBX",4,1)) ;file results
K GMRCERR,FDA,GMRCFDA
I $$STSCHG^GMRCDIS(GMRCDA) S FDA(1,123,GMRCDA_",",8)=6
S FDA(1,123,GMRCDA_",",9)=12
D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and status
D ;send notifications
. I $P(^GMR(123,GMRCDA,12),U,5)="F" Q ;DIS from placer before IFC
. N GMRCORTX
. S GMRCORTX="Remote result removed from "_$$ORTX^GMRCAU(+GMRCDA)
. D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,63,,1)
D ;send appl ACK
. D APPACK^GMRCIAC2(GMRCDA,"AA") ; send app. ACK and unlock record
K ^TMP("GMRCID",$J)
Q
;
OTHER(GMRCAR) ;process most IFC actions
;will process the receive, schedule, DC, cancel and added comment action
;
;Input:
; GMRCAR = array name containing message
; e.g. ^TMP("GMRCIF",$J)
;
N GMRCDA,GMRCFDA,GMRCORC,GMRCLAT,GMRCACT,GMRCROL,FDA
K ^TMP("GMRCIN",$J)
M ^TMP("GMRCIN",$J)=@GMRCAR
;
S GMRCORC=^TMP("GMRCIN",$J,"ORC")
S GMRCDA=$$GETDA^GMRCIAC2(GMRCORC) ;get ien to work on
S GMRCROL=$P(^GMR(123,GMRCDA,12),U,5)
I '$$LOCKREC^GMRCUTL1(GMRCDA) D Q ;couldn't lock record
. D APPACK^GMRCIAC2(GMRCDA,"AR",901) ; send app. ACK
. K ^TMP("GMRCIN",$J) Q
;
I $P(GMRCORC,"|")'="IP" D ; status update
. N GMRCOS S GMRCOS=$P(GMRCORC,"|",5)
. S GMRCFDA(8)=$S(GMRCOS="IP":6,GMRCOS="SC":8,GMRCOS="CA":13,1:1)
. ; IP=receive, SC=schedule, CA=cancel, DC=discontinue
D ; get last action taken
. I '$G(GMRCFDA(8)) S (GMRCFDA(9),GMRCLAT)=20 Q
. I GMRCFDA(8)=6 S (GMRCFDA(9),GMRCLAT)=21 Q
. I GMRCFDA(8)=8 S (GMRCFDA(9),GMRCLAT)=8 Q
. I GMRCFDA(8)=1 S (GMRCFDA(9),GMRCLAT)=6 Q
. I GMRCFDA(8)=13 S (GMRCFDA(9),GMRCLAT)=19 Q
; ^--last action taken
; v-- check to see if a dup transmission
I $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAT,GMRCORC) Q
;
M FDA(1,123,GMRCDA_",")=GMRCFDA
D UPDATE^DIE("","FDA(1)",,"GMRCERR") ;file last action and update status
K GMRCFDA
D FILEACT^GMRCIAC2(GMRCDA,GMRCLAT,,$NA(^TMP("GMRCIN",$J)))
D ;send notifications
. N GMRCTX,GMRCNOT,GMRCFL
. S GMRCFL=1
. I GMRCLAT=20!(GMRCLAT=8)!(GMRCLAT=21) D
.. I GMRCLAT=20 D I '$D(GMRCTX) Q
... I $P(^GMR(123,GMRCDA,40,1,0),U,2)'=24 D Q
.... S GMRCTX="Comment Added to remote"
... N ACT S ACT=1
... F S ACT=$O(^GMR(123,GMRCDA,40,ACT)) Q:'ACT!($D(GMRCTX)) D
.... I $P(^GMR(123,GMRCDA,40,ACT,0),U,2)=25,$O(^GMR(123,GMRCDA,40,ACT)) D
..... S GMRCTX="Comment Added to remote"
.. I '$D(GMRCTX),GMRCROL="F" Q ;sch & rec on filler part of FWD 2 IFC
.. I GMRCLAT=8 S GMRCTX="Scheduled remote"
.. I GMRCLAT=21 S GMRCTX="Received remote"
.. S GMRCTX=GMRCTX_" Consult: "_$$ORTX^GMRCAU(+GMRCDA)
.. S GMRCNOT=63
. I GMRCLAT=6 D
.. S GMRCFL=$$DCNOTE^GMRCADC(GMRCDA,.5)
.. S GMRCTX="Discontinued remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
.. S GMRCNOT=23
. I GMRCLAT=19 D
.. I GMRCROL="F" Q ;canc on a filler is part of FWD 2 IFC
.. S GMRCTX="Cancelled remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
.. S GMRCNOT=30
. I '$D(GMRCNOT) Q ;don't send any alerts
. D MSG^GMRCP($P(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,GMRCNOT,,GMRCFL)
;
D ;send appl ACK
. D APPACK^GMRCIAC2(GMRCDA,"AA") ;send app. ACK and unlock record
K ^TMP("GMRCIN",$J)
Q
;
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
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;don't start here!
QUIT
NW(ARRAY) ;process and file new order
+1 ;Input:
+2 ; ARRAY = name of array containing message parts
+3 ;
+4 NEW GMRCFDA,GMRCORC,GMRCDA,GMRCITM,GMRCITER,GMRCROUT,GMRCFCN,GMRCLAC
+5 KILL ^TMP("GMRCIN",$JOB)
+6 MERGE ^TMP("GMRCIN",$JOB)=@ARRAY
+7 SET GMRCORC=^TMP("GMRCIN",$JOB,"ORC")
+8 ;Check for order already being on file
Begin DoDot:1
+9 SET GMRCFCN=+$PIECE(GMRCORC,"|",2)
+10 SET GMRCROUT=$$IEN^XUAF4($PIECE($PIECE(GMRCORC,"|",2),U,2))
+11 ;no dup
IF '$ORDER(^GMR(123,"AIFC",GMRCROUT,GMRCFCN,0))
QUIT
+12 SET GMRCITER=802
+13 ;send app. ack w/ error
DO APPACK^GMRCIAC2(0,"AR",GMRCITER)
+14 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
IF $DATA(GMRCITER)
QUIT
+15 ;prepare reject message (no PID)
IF '$DATA(^TMP("GMRCIN",$JOB,"PID"))
QUIT
+16 ;get patient DFN from ICN in message
Begin DoDot:1
+17 NEW PAT
+18 SET PAT=$$GETDFN^MPIF001(+$PIECE(^TMP("GMRCIN",$JOB,"PID"),"|",2))
+19 IF +PAT'>1
SET GMRCFDA(.02)=""
QUIT
+20 SET GMRCFDA(.02)=+PAT
End DoDot:1
+21 ;reject message, patient is unknown
IF '$GET(GMRCFDA(.02))
Begin DoDot:1
+22 NEW STA
SET STA=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"ORC"),"|",2),U,2)
+23 NEW OBR
SET OBR=^TMP("GMRCIN",$JOB,"OBR")
+24 DO PTERRMSG^GMRCIERR(^TMP("GMRCIN",$JOB,"PID"),STA,,OBR)
+25 ; send app. ack w/error
DO APPACK^GMRCIAC2(0,"AR",201)
+26 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
QUIT
+27 ;get ordered item and service
Begin DoDot:1
+28 SET GMRCITM=$PIECE(^TMP("GMRCIN",$JOB,"OBR"),"|",4)
+29 ; proc
IF GMRCITM["VA1233"
Begin DoDot:2
+30 NEW PROC
+31 SET PROC=$$GETPROC^GMRCIUTL(GMRCITM)
+32 IF +PROC'>0!('$PIECE(PROC,U,2))
SET GMRCITER=$PIECE(PROC,U,3)
QUIT
+33 SET GMRCFDA(4)=$PIECE(PROC,U)_";GMR(123.3,"
+34 SET GMRCFDA(1)=$PIECE(PROC,U,2)
End DoDot:2
+35 IF GMRCITM["VA1235"
Begin DoDot:2
+36 NEW SERV
+37 ;consult
SET SERV=$$GETSERV^GMRCIUTL(GMRCITM)
+38 IF +SERV'>0
SET GMRCITER=$PIECE(SERV,U,3)
+39 SET GMRCFDA(1)=SERV
End DoDot:2
End DoDot:1
+40 ;error in procedure or service, reject new order
IF $DATA(GMRCITER)
Begin DoDot:1
+41 ; send app. ACK
DO APPACK^GMRCIAC2(0,"AR",GMRCITER)
+42 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
QUIT
+43 ;
+44 SET GMRCFDA(.01)=$$NOW^XLFDT
+45 SET GMRCFDA(3)=$$HL7TFM^XLFDT($PIECE(GMRCORC,"|",15))
+46 SET GMRCFDA(6)=$$FIND1^DIC(101,"","X","GMRCPLACE - ON CALL")
+47 ;get urgency to file
Begin DoDot:1
+48 NEW URG
+49 SET URG=$$URG^GMRCHL7A($PIECE($PIECE(GMRCORC,"|",7),U,6))
+50 SET GMRCFDA(5)=$$FIND1^DIC(101,"","X","GMRCURGENCY - "_URG)
End DoDot:1
+51 SET GMRCFDA(8)=5
+52 SET GMRCFDA(9)=$SELECT($PIECE(GMRCORC,"|",16)["FI":24,1:23)
SET GMRCLAC=GMRCFDA(9)
+53 SET GMRCFDA(14)=$PIECE(^TMP("GMRCIN",$JOB,"OBR"),"|",18)
+54 SET GMRCFDA(.05)=$$IEN^XUAF4(+$PIECE(GMRCORC,"|",17))
+55 SET GMRCFDA(.06)=GMRCFCN
+56 SET GMRCFDA(.07)=GMRCROUT
+57 ;get and set ordering prov info & entering person info
Begin DoDot:1
+58 NEW GMRCOP
+59 SET GMRCOP=$$FMNAME^XLFNAME($PIECE(GMRCORC,"|",12))
+60 IF '$LENGTH(GMRCOP)
QUIT
+61 SET GMRCFDA(.126)=GMRCOP
+62 QUIT
End DoDot:1
+63 SET GMRCFDA(.125)="F"
+64 IF $LENGTH($PIECE(GMRCORC,"|",14))
Begin DoDot:1
+65 NEW GMRCP14
SET GMRCP14=$PIECE(GMRCORC,"|",14)
+66 ; requestor's phone number
SET GMRCFDA(.132)=$PIECE(GMRCP14,"B")
+67 ; requestor's dig pager
SET GMRCFDA(.133)=$PIECE(GMRCP14,"B",2)
End DoDot:1
+68 SET GMRCFDA(13)=$SELECT($DATA(GMRCFDA(4)):"P",1:"C")
+69 IF $DATA(^TMP("GMRCIN",$JOB,"OBX",2))
Begin DoDot:1
+70 SET GMRCFDA(30)=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBX",2,1),"|",5),U,2)
+71 SET GMRCFDA(30.1)=$PIECE($PIECE(^TMP("GMRCIN",$JOB,"OBX",2,1),"|",5),U)
End DoDot:1
+72 MERGE FDA(1,123,"+1,")=GMRCFDA
+73 DO UPDATE^DIE("","FDA(1)","GMRCDA","GMRCERR")
+74 ;couldn't get new consult #
IF '$DATA(GMRCDA)
Begin DoDot:1
+75 ; send app. ACK
DO APPACK^GMRCIAC2(0,"AR",901)
+76 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
QUIT
+77 KILL GMRCFDA,FDA
+78 ; file reason for request
Begin DoDot:1
+79 DO TRIMWP^GMRCIUTL($NAME(^TMP("GMRCIN",$JOB,"OBX",1)),5)
+80 DO WP^DIE(123,GMRCDA(1)_",",20,"K",$NAME(^TMP("GMRCIN",$JOB,"OBX",1)))
+81 QUIT
End DoDot:1
+82 ;file activity tracking
Begin DoDot:1
+83 NEW GMRCSEG
+84 SET GMRCSEG("ORC")=GMRCORC
+85 SET GMRCSEG("OBX",5,1)=^TMP("GMRCIN",$JOB,"OBX",5,1)
+86 DO FILEACT^GMRCIAC2(GMRCDA(1),GMRCLAC,,"GMRCSEG")
End DoDot:1
+87 ;print SF-513
Begin DoDot:1
+88 ;don't print if part of a FWD to IFC
IF GMRCLAC=24
QUIT
+89 DO PRNT^GMRCUTL1("",GMRCDA(1))
End DoDot:1
+90 ;send notifications
Begin DoDot:1
+91 ;no alerts yet if part of FWD to IFC
IF GMRCLAC=24
QUIT
+92 NEW GMRCORTX
+93 SET GMRCORTX="New remotely ordered consult "_$$ORTX^GMRCAU(+GMRCDA(1))
+94 DO MSG^GMRCP($PIECE(^GMR(123,GMRCDA(1),0),U,2),GMRCORTX,GMRCDA(1),27,,1)
End DoDot:1
+95 ;send appl ack :-(
Begin DoDot:1
+96 NEW GMRCRSLT
+97 DO RESP^GMRCIUTL("AA",HL("MID"),$PIECE(GMRCORC,"|"),GMRCDA(1))
+98 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.GMRCRSLT)
End DoDot:1
+99 KILL ^TMP("GMRCIN",$JOB)
+100 QUIT
+101 ;
DIS(GMRCAR) ;dis-associate a result from a remote request
+1 ;Input:
+2 ; GMRCAR = array name containing message
+3 ; e.g. ^TMP("GMRCIF",$J)
+4 NEW GMRCDA,GMRCFDA,FDA,GMRCERR,GMRCORC
+5 MERGE ^TMP("GMRCID",$JOB)=@GMRCAR
+6 SET GMRCORC=^TMP("GMRCID",$JOB,"ORC")
+7 SET GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
+8 ;couldn't lock record
IF '$$LOCKREC^GMRCUTL1(GMRCDA)
Begin DoDot:1
+9 ;send app. ACK
DO APPACK^GMRCIAC2(GMRCDA,"AR",901)
+10 KILL ^TMP("GMRCID",$JOB)
QUIT
End DoDot:1
QUIT
+11 ; v--check to see if a dup transmission
+12 IF $$DUPACT^GMRCIAC2(GMRCDA,12,GMRCORC,^TMP("GMRCID",$JOB,"OBX",4,1))
QUIT
+13 ;
+14 ; act. tracking
DO FILEACT^GMRCIAC2(GMRCDA,12,,$NAME(^TMP("GMRCID",$JOB)))
+15 ;file results
DO FILRES^GMRCIAC2(GMRCDA,^TMP("GMRCID",$JOB,"OBX",4,1))
+16 KILL GMRCERR,FDA,GMRCFDA
+17 IF $$STSCHG^GMRCDIS(GMRCDA)
SET FDA(1,123,GMRCDA_",",8)=6
+18 SET FDA(1,123,GMRCDA_",",9)=12
+19 ;file last action and status
DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+20 ;send notifications
Begin DoDot:1
+21 ;DIS from placer before IFC
IF $PIECE(^GMR(123,GMRCDA,12),U,5)="F"
QUIT
+22 NEW GMRCORTX
+23 SET GMRCORTX="Remote result removed from "_$$ORTX^GMRCAU(+GMRCDA)
+24 DO MSG^GMRCP($PIECE(^GMR(123,GMRCDA,0),U,2),GMRCORTX,GMRCDA,63,,1)
End DoDot:1
+25 ;send appl ACK
Begin DoDot:1
+26 ; send app. ACK and unlock record
DO APPACK^GMRCIAC2(GMRCDA,"AA")
End DoDot:1
+27 KILL ^TMP("GMRCID",$JOB)
+28 QUIT
+29 ;
OTHER(GMRCAR) ;process most IFC actions
+1 ;will process the receive, schedule, DC, cancel and added comment action
+2 ;
+3 ;Input:
+4 ; GMRCAR = array name containing message
+5 ; e.g. ^TMP("GMRCIF",$J)
+6 ;
+7 NEW GMRCDA,GMRCFDA,GMRCORC,GMRCLAT,GMRCACT,GMRCROL,FDA
+8 KILL ^TMP("GMRCIN",$JOB)
+9 MERGE ^TMP("GMRCIN",$JOB)=@GMRCAR
+10 ;
+11 SET GMRCORC=^TMP("GMRCIN",$JOB,"ORC")
+12 ;get ien to work on
SET GMRCDA=$$GETDA^GMRCIAC2(GMRCORC)
+13 SET GMRCROL=$PIECE(^GMR(123,GMRCDA,12),U,5)
+14 ;couldn't lock record
IF '$$LOCKREC^GMRCUTL1(GMRCDA)
Begin DoDot:1
+15 ; send app. ACK
DO APPACK^GMRCIAC2(GMRCDA,"AR",901)
+16 KILL ^TMP("GMRCIN",$JOB)
QUIT
End DoDot:1
QUIT
+17 ;
+18 ; status update
IF $PIECE(GMRCORC,"|")'="IP"
Begin DoDot:1
+19 NEW GMRCOS
SET GMRCOS=$PIECE(GMRCORC,"|",5)
+20 SET GMRCFDA(8)=$SELECT(GMRCOS="IP":6,GMRCOS="SC":8,GMRCOS="CA":13,1:1)
+21 ; IP=receive, SC=schedule, CA=cancel, DC=discontinue
End DoDot:1
+22 ; get last action taken
Begin DoDot:1
+23 IF '$GET(GMRCFDA(8))
SET (GMRCFDA(9),GMRCLAT)=20
QUIT
+24 IF GMRCFDA(8)=6
SET (GMRCFDA(9),GMRCLAT)=21
QUIT
+25 IF GMRCFDA(8)=8
SET (GMRCFDA(9),GMRCLAT)=8
QUIT
+26 IF GMRCFDA(8)=1
SET (GMRCFDA(9),GMRCLAT)=6
QUIT
+27 IF GMRCFDA(8)=13
SET (GMRCFDA(9),GMRCLAT)=19
QUIT
End DoDot:1
+28 ; ^--last action taken
+29 ; v-- check to see if a dup transmission
+30 IF $$DUPACT^GMRCIAC2(GMRCDA,GMRCLAT,GMRCORC)
QUIT
+31 ;
+32 MERGE FDA(1,123,GMRCDA_",")=GMRCFDA
+33 ;file last action and update status
DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+34 KILL GMRCFDA
+35 DO FILEACT^GMRCIAC2(GMRCDA,GMRCLAT,,$NAME(^TMP("GMRCIN",$JOB)))
+36 ;send notifications
Begin DoDot:1
+37 NEW GMRCTX,GMRCNOT,GMRCFL
+38 SET GMRCFL=1
+39 IF GMRCLAT=20!(GMRCLAT=8)!(GMRCLAT=21)
Begin DoDot:2
+40 IF GMRCLAT=20
Begin DoDot:3
+41 IF $PIECE(^GMR(123,GMRCDA,40,1,0),U,2)'=24
Begin DoDot:4
+42 SET GMRCTX="Comment Added to remote"
End DoDot:4
QUIT
+43 NEW ACT
SET ACT=1
+44 FOR
SET ACT=$ORDER(^GMR(123,GMRCDA,40,ACT))
IF 'ACT!($DATA(GMRCTX))
QUIT
Begin DoDot:4
+45 IF $PIECE(^GMR(123,GMRCDA,40,ACT,0),U,2)=25
IF $ORDER(^GMR(123,GMRCDA,40,ACT))
Begin DoDot:5
+46 SET GMRCTX="Comment Added to remote"
End DoDot:5
End DoDot:4
End DoDot:3
IF '$DATA(GMRCTX)
QUIT
+47 ;sch & rec on filler part of FWD 2 IFC
IF '$DATA(GMRCTX)
IF GMRCROL="F"
QUIT
+48 IF GMRCLAT=8
SET GMRCTX="Scheduled remote"
+49 IF GMRCLAT=21
SET GMRCTX="Received remote"
+50 SET GMRCTX=GMRCTX_" Consult: "_$$ORTX^GMRCAU(+GMRCDA)
+51 SET GMRCNOT=63
End DoDot:2
+52 IF GMRCLAT=6
Begin DoDot:2
+53 SET GMRCFL=$$DCNOTE^GMRCADC(GMRCDA,.5)
+54 SET GMRCTX="Discontinued remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
+55 SET GMRCNOT=23
End DoDot:2
+56 IF GMRCLAT=19
Begin DoDot:2
+57 ;canc on a filler is part of FWD 2 IFC
IF GMRCROL="F"
QUIT
+58 SET GMRCTX="Cancelled remote Consult: "_$$ORTX^GMRCAU(+GMRCDA)
+59 SET GMRCNOT=30
End DoDot:2
+60 ;don't send any alerts
IF '$DATA(GMRCNOT)
QUIT
+61 DO MSG^GMRCP($PIECE(^GMR(123,GMRCDA,0),U,2),GMRCTX,GMRCDA,GMRCNOT,,GMRCFL)
End DoDot:1
+62 ;
+63 ;send appl ACK
Begin DoDot:1
+64 ;send app. ACK and unlock record
DO APPACK^GMRCIAC2(GMRCDA,"AA")
End DoDot:1
+65 KILL ^TMP("GMRCIN",$JOB)
+66 QUIT
+67 ;
