GMRCGUIC ;SLC/DCM,JFR - GUI actions for editing consults; 3/13/03 12:21 ;Sep 14, 2020@11:26:29
;;3.0;CONSULT/REQUEST TRACKING;**4,12,20,15,22,33,66,73,85,81,145**;DEC 27, 1997;Build 18
;
; This routine invokes IA #2698 (ORD(101.42)), #872(ORD(101)), #2713 (ORB3F1), #2051 (FIND1^DIC)
; #2053 (DIE), #2056 (GET1^DIQ), #2690 (ORB3FUP1), #5679 (LEXU), #10103 (XLFDT), #10104 (XLFSTR), #5747 (ICDEX)
;
RFQ(GMRCO,MSG,ND,NOW) ;File Reason For Request field 20
N GMRCND,GMRCNT
S GMRCND=$O(^GMR(123,GMRCO,20,0)) I GMRCND="" S GMRCFLD(20)="Reason For Request: No Previous Value^20" Q
M ^TMP("GMRCFLD20",$J,20)=^GMR(123,GMRCO,20)
S GMRCFLD(20)=$NAME(^TMP("GMRCFLD20",$J,20))
K ^GMR(123,GMRCO,20)
S ^GMR(123,GMRCO,20,0)="^^^^"_DT_"^"
S GMRCND="",GMRCNT=1 F S GMRCND=$O(@MSG@(ND,GMRCND)) Q:GMRCND="" S ^GMR(123,GMRCO,20,GMRCNT,0)=@MSG@(ND,GMRCND),GMRCNT=GMRCNT+1
S $P(^GMR(123,GMRCO,20,0),"^",3)=GMRCNT-1,$P(^(0),"^",4)=GMRCNT-1
Q
FILE(GMRCO,MSG,GMRCLM) ;File Edit changes
;GMRCO=Record IEN, GMRCCOM=Comment Array
;MSG=^TMP global where the data resides, i.e., MSG="^TMP(""GMRCR"",$J)"
; Data is stored in subscripted nodes: ^TMP("GMRCR",$J,1)="GMRCSS^2"
; Word processing data is stored in second subscripted node:
; ^TMP("GMRCR",$J,9,1)="This is word processing data."
;GMRCSS=To Service GMRCPROC=procedure/Request Type
;GMRCURG=Urgency GMRCPL=Place Of Consultation
;GMRCATN=Attention To GMRCINO=Service is In/Out Patient
;GMRCDIAG=Provisional Diagnosis .GMRCRFQ=Reason For Request array
;GMRCREQ=Procedure or Request; i.e., GMRCRQT=1727=^ORD(101,1727,0)='Procedure';GMRCRQT=1296=^ORD(101,1296,0)='Consult'
;GMRCITM=Item ordered for field .1 (stored in ^GMR(123,GMRCO,1.11,
;GMRCLM=coming from List Manager instead of the GUI
;GMRCERDT=Clinically Indicated Date GMRCDSID=DST ID
;GMRCCSYS=coding system for provisional dx GMRCDXDT=Date of provisional dx GMRCLABL=label applied to dx code for display purposes e.g. "ICD-9-CM"
;
I '$D(GMRCO)!('+GMRCO) Q
N GMRCSS,GMRCPROC,GMRCURG,GMRCPL,GMRCATN,GMRCRQT
N GMRCION,GMRCDIAG,GMRCDXCD,GMRCACTN,GMRCERDT,GMRCCSYS,GMRCDXDT,GMRCLABL,CODINTXT,GMRCDSID
S GMRCDT=$$NOW^XLFDT
S GMRCMSG="",GMRCNOD=0
F S GMRCNOD=$O(@MSG@(GMRCNOD)) Q:GMRCNOD="" S GMRCMSG=@MSG@(GMRCNOD) D
.I $P(GMRCMSG,"^",1)="COMMENT" D COMMENT^GMRCGUIU(GMRCO,MSG,GMRCNOD,$P(GMRCMSG,"^",2)) Q
.I $P(GMRCMSG,"^",1)="GMRCRFQ" D RFQ(GMRCO,MSG,GMRCNOD,GMRCDT) Q
.I $P(GMRCMSG,"^",1)="GMRCSS" S GMRCSS=$P(GMRCMSG,"^",2),GMRCFLD(1)=$P(^GMR(123.5,$P(^GMR(123,GMRCO,0),"^",5),0),"^",1)_"^1" Q
.I $P(GMRCMSG,"^",1)="GMRCITM" S GMRCITM=$P(GMRCMSG,"^",2),GMRCFLD(.1)=^GMR(123,GMRCO,1.11)_"^.1" Q
.I $P(GMRCMSG,"^",1)="GMRCPROC" Q ;S GMRCFLD(4)=+$P(^GMR(123,+GMRCO,0),"^",8)_"^4" D Q ;ignore procedure, can't be changed currently
.; ..S GMRCPROC=$P(GMRCMSG,"^",2) I $L($P(^GMR(123,GMRCO,0),"^",8)),$P(GMRCMSG,"^",2)="" S GMRCPROC="DELETE"
.I $P(GMRCMSG,"^",1)="GMRCURG" S GMRCURG=$P(GMRCMSG,"^",2),GMRCFLD(5)=$S(+$P(^GMR(123,+GMRCO,0),"^",9):$P(^ORD(101,+$P(^GMR(123,+GMRCO,0),"^",9),0),"^",2),1:"")_"^"_$P(^GMR(123,+GMRCO,0),"^",9) Q
.I $P(GMRCMSG,"^",1)="GMRCPL" D Q
..S GMRCPL=$P(GMRCMSG,"^",2) I '+GMRCPL D
...S GMRCPL="GMRCPLACE - "_$S(GMRCPL="C":"ON CALL",GMRCPL="B":"BEDSIDE",GMRCPL="E":"EMERGENCY ROOM",1:GMRCPL),GMRCPL=$O(^ORD(101,"B",GMRCPL,0))
..S GMRCFLD(6)=$S(+$P(^GMR(123,+GMRCO,0),"^",10):$P($P(^ORD(101,+$P(^GMR(123,+GMRCO,0),"^",10),0),"^",1)," - ",2),1:"")_"^6"
..Q
.I $P(GMRCMSG,"^",1)="GMRCATN" S GMRCATN=$P(GMRCMSG,"^",2),GMRCFLD(7)=$S(+$P(^GMR(123,+GMRCO,0),"^",11):$$GET1^DIQ(200,+$P(^GMR(123,+GMRCO,0),"^",11),.01),1:"")_"^7" Q
.I $P(GMRCMSG,"^",1)="GMRCREQ" S GMRCREQ=$P(GMRCMSG,"^",2),GMRCFLD(13)=$S($P(^GMR(123,+GMRCO,0),"^",17)="P":"Procedure",1:"Consult")_"^13" Q
.I $P(GMRCMSG,"^",1)="GMRCION" S GMRCION=$P(GMRCMSG,"^",2),GMRCFLD(14)=$S($P(^GMR(123,+GMRCO,0),"^",18)="I":"Inpatient",$P(^(0),"^",18)="O":"Outpatient",1:"")_"^14" Q
.I $P(GMRCMSG,"^",1)="GMRCERDT" S GMRCERDT=$P(GMRCMSG,"^",2),GMRCFLD(17)=$S(+$P(^GMR(123,+GMRCO,0),"^",24)>0:$$FMTE^XLFDT($P(^GMR(123,+GMRCO,0),"^",24)),1:"")_"^17" Q
.I $P(GMRCMSG,"^",1)="GMRCDSID" D Q
..S:$D(^GMR(123,+GMRCO,75)) GMRCDSID=$P(GMRCMSG,"^",2),GMRCFLD(85)=$S(^GMR(123,+GMRCO,75)>0:^GMR(123,+GMRCO,75),1:"")_"^85"
..S:'$D(^GMR(123,+GMRCO,75)) GMRCDSID=$P(GMRCMSG,"^",2),GMRCFLD(85)=GMRCDSID_"^85"
.I $P(GMRCMSG,"^",1)="GMRCDIAG" D Q
..S GMRCDIAG=$P(GMRCMSG,"^",2)
..S GMRCFLD(30)=$G(^GMR(123,+GMRCO,30))_"^30"
..I $P(GMRCFLD(30),U)="" S $P(GMRCFLD(30),U)="No Previous Value"
..I $L($P(GMRCMSG,U,3)) D
...S GMRCDXCD=$P(GMRCMSG,"^",3)
...S GMRCCSYS=$$CODECS^ICDEX($G(GMRCDXCD),80) S GMRCCSYS=$S($P(GMRCCSYS,U)=1:"ICD",$P(GMRCCSYS,U)=30:"10D",1:"")
...S GMRCLABL=$P($G(^GMR(123,+GMRCO,30.1)),U,3)
...S GMRCLABL=$S($G(GMRCLABL)="ICD":"ICD-9-CM",$G(GMRCLABL)="10D":"ICD-10-CM",1:"")
...S GMRCFLD(30.1)=$P($G(^GMR(123,+GMRCO,30.1)),U)_"("_$G(GMRCLABL)_")"_"^30.1"
...S GMRCDXDT=$P($G(^GMR(123,+GMRCO,30.1)),U,2)
...S:$G(GMRCDXDT)="" GMRCFLD(30.2)="No Previous Value"_"^30.2"
...S:DT>+$G(GMRCDXDT) GMRCFLD(30.2)=$$FMTE^XLFDT(GMRCDXDT,"D")_"^30.2"
...I GMRCCSYS'=$P($G(^GMR(123,+GMRCO,30.1)),U,3) S GMRCFLD(30.3)=$S($P($G(^GMR(123,+GMRCO,30.1)),U,3)="ICD":"ICD-9-CM",$P($G(^GMR(123,+GMRCO,30.1)),U,3)="10D":"ICD-10-CM",1:"")_"^30.3"
..I $G(GMRCDXCD)'="" S CODINTXT="("_GMRCDXCD_")" D
... I GMRCDIAG[CODINTXT S GMRCDIAG=$E(GMRCDIAG,0,($L(GMRCDIAG)-$L(CODINTXT))) S GMRCDIAG=$$TRIM^XLFSTR(GMRCDIAG,"R")
.Q
S:'$D(GMRCLM) GMRCGUIF=1
S GMRCACTN=$$EN^GMRCEDT3(GMRCO)
S DR=$$SETDA^GMRCGUIU($G(GMRCSS),$G(GMRCPROC),$G(GMRCURG),$G(GMRCPL),$G(GMRCATN),$G(GMRCRQT),$G(GMRCION),$G(GMRCERDT),$G(GMRCDIAG),$G(GMRCDXCD),$G(GMRCDSID)) I $L(DR) D
.S DIE="^GMR(123,",DA=GMRCO
.L +^GMR(123,GMRCO):$S($G(DILOCKTM)>0:DILOCKTM,1:5) ;WAT/66 added timeout
.D ^DIE
.S DR="8////^S X=5;9////^S X=11"
.D ^DIE
.L -^GMR(123,GMRCO)
.K DIE,DR,DA
.Q
S DFN=$P(^GMR(123,+GMRCO,0),"^",2),GMRCPROV=$P(^(0),"^",14),GMRCTYPE=$P(^(0),"^",17),GMRCTRLC="XX^RESUBMIT",VISIT="",RMBED=""
D EN^GMRCHL7(DFN,+GMRCO,GMRCTYPE,RMBED,GMRCTRLC,$G(DUZ),VISIT,.GMRCOM)
S GMRCSVC=$S($G(GMRCSS):GMRCSS,1:$P(^GMR(123,+GMRCO,0),U,5))
S GMRCORTX="Resubmitted consult "_$$ORTX^GMRCAU(+GMRCO)
S GMRCORTX=GMRCORTX_$S($G(GMRCURG):" ("_$P(^ORD(101,+GMRCURG,0),"^",2)_")",+$P(^GMR(123,+GMRCO,0),U,9):"( "_$P(^ORD(101,+$P(^GMR(123,+GMRCO,0),U,9),0),"^",2)_" )",1:"")
S GMRCFL=1
D MSG^GMRCP(DFN,GMRCORTX,+GMRCO,27,.GMRCADUZ,GMRCFL) ;Send notification of NEW consult
D PRNT^GMRCUTL1(+$P(^GMR(123,+GMRCO,0),U,5),+GMRCO) ;send 513 to service
;Next line gets rid of alert
I $D(XQAID),$L(XQAID) D
. N GMRCCORY
. S XQAKILL=$$XQAKILL^ORB3F1 D DEL^ORB3FUP1(.GMRCCORY,XQAID)
I $P($G(^GMR(123,+GMRCO,12)),U,5)="P" D
. D TRIGR^GMRCIEVT(GMRCO,GMRCACTN)
D GUIC^GMRCGUIU
Q
SEND(GMRCO,GLOBAL) ;Get data fields to send to GUI for editing consult
;GMRCO=record being edited GLOBAL=Global Referece, i.e., "^TMP("GMRCR",$J)"
K @GLOBAL
N ND,GMRCSX,TYPE,NDX,GMRCCPTR,GMRCCSYS,GMRCCODE,CODINTXT
S ND=1,GMRCSX=""
I '$D(GMRCO)!('+GMRCO) Q
S GMRC(0)=$G(^GMR(123,+GMRCO,0)) Q:'$L(GMRC(0))
S GMRCSS=$P(GMRC(0),"^",5),GMRCPROC=$P(GMRC(0),"^",8)
S GMRCURG=$P(GMRC(0),"^",9),GMRCPL=$P(GMRC(0),"^",10)
S GMRCATN=$P(GMRC(0),"^",11),GMRCINO=$P(GMRC(0),"^",18)
S GMRCREQ=$P(GMRC(0),"^",17),GMRCERDT=$P(GMRC(0),"^",24)
S:$D(^GMR(123,+GMRCO,75)) GMRCDSID=$P(^GMR(123,+GMRCO,75),U)
S GMRCDIAG=$G(^GMR(123,+GMRCO,30)) I $L($G(^(30.1))) D
. S GMRCCODE=$P($G(^GMR(123,+GMRCO,30.1)),"^",1)
. S GMRCCSYS=$P($G(^GMR(123,+GMRCO,30.1)),"^",3)
. S GMRCCPTR=$S(GMRCCSYS="ICD":1,1:30)
. I $G(GMRCCODE)'="" D ;users expect to see prov dx text and dx code in edit/resubmit dialog
.. S CODINTXT=" ("_GMRCCODE_")"
.. Q:GMRCDIAG[CODINTXT
.. S GMRCDIAG=GMRCDIAG_CODINTXT
. S GMRCDIAG=GMRCDIAG_U_$G(GMRCCODE)
S GMRCPROV=$S($P(^GMR(123,+GMRCO,0),U,14):$$GET1^DIQ(200,+$P(^(0),U,14),.01),1:"")
S @GLOBAL@(ND,0)="~SERVICE",ND=ND+1
I +GMRCSS S GMRCSX=$P(^GMR(123.5,GMRCSS,0),"^",1),@GLOBAL@(ND,0)="d"_GMRCSX_"^"_GMRCSS_"^",ND=ND+1,GMRCSX=""
E S @GLOBAL@(ND,0)="d"_"^^",ND=ND+1
S @GLOBAL@(ND,0)="~PROCEDURE",ND=ND+1
I $L(GMRCPROC),+GMRCPROC D
.S GMRCSX=$$UP^XLFSTR($$GET1^DIQ(123.3,+GMRCPROC,.01))
.S GMRCSY=$$FIND1^DIC(101.43,,"QX",+GMRCPROC_";99PRC","ID")
.I +GMRCSY D
..S @GLOBAL@(ND,0)="d"_GMRCSY_"^"_GMRCSX,ND=ND+1
..Q
E S @GLOBAL@(ND,0)="d^^"
S @GLOBAL@(ND,0)="~TYPE",ND=ND+1
I $L(GMRCREQ) D I '$L(GMRCREQ) S @GLOBAL@(ND,0)="d^^"
. S GMRCSX=$S(GMRCREQ="P":"PROCEDURE",1:"CONSULT")
. S @GLOBAL@(ND,0)="d"_$E(GMRCSX,1)_"^"_GMRCSX_"^"_GMRCREQ
. S GMRCSX=""
S ND=ND+1
S @GLOBAL@(ND,0)="~CATEGORY",ND=ND+1
I $L(GMRCINO) D S ND=ND+1,GMRCSX=""
.S @GLOBAL@(ND,0)="d"_GMRCINO_"^"_$S(GMRCINO="I":"INPATIENT",1:"OUTPATIENT")_"^"
.S @GLOBAL@(ND,0)=@GLOBAL@(ND,0)_$S(GMRCINO="I":$O(^ORD(101,"B","GMRCURGENCYM CSLT - INPATIENT",0)),1:$O(^ORD(101,"B","GMRCURGENCYM - OUTPATIENT",0)))
.Q
E S @GLOBAL@(ND,0)="d^^"
S @GLOBAL@(ND,0)="~DIAGNOSIS",ND=ND+1
I $L(GMRCDIAG) S @GLOBAL@(ND,0)="d"_GMRCDIAG,ND=ND+1
E S @GLOBAL@(ND,0)="d"
S @GLOBAL@(ND,0)="~PLACE",ND=ND+1
I +GMRCPL D S ND=ND+1,GMRCSX=""
.S GMRCSX=$P($P(^ORD(101,GMRCPL,0),"^",1),"GMRCPLACE - ",2),GMRCSX=$S(GMRCSX="ON CALL":"CONSULTANTS CHOICE",1:GMRCSX),@GLOBAL@(ND,0)="d"_$E(GMRCSX,1)_"^"_GMRCSX_"^"_GMRCPL
.Q
E S @GLOBAL@(ND,0)="d^^",ND=ND+1
S @GLOBAL@(ND,0)="~ATTENTION",ND=ND+1
I +GMRCATN S GMRCSX=$$GET1^DIQ(200,GMRCATN,.01),@GLOBAL@(ND,0)="d"_GMRCATN_"^"_GMRCSX_"^"_GMRCATN,ND=ND+1,GMRCSX=""
E S @GLOBAL@(ND,0)="d^^",ND=ND+1
S @GLOBAL@(ND,0)="~CLINICALLY",ND=ND+1
I GMRCERDT S @GLOBAL@(ND,0)="d"_"^"_GMRCERDT,ND=ND+1
E S @GLOBAL@(ND,0)="d^"
S @GLOBAL@(ND,0)="~URGENCY",ND=ND+1
I +GMRCURG S GMRCSX=$P($P(^ORD(101,GMRCURG,0),"^",1),"GMRCURGENCY - ",2),GMRCURGY=$O(^ORD(101.42,"S.GMRCO",GMRCSX,0)) I $L(GMRCSX) D
.S GMRCSY=$O(^ORD(101.42,"B",GMRCSX,0))
.S @GLOBAL@(ND,0)="d"_GMRCSY_"^"_GMRCSX_"^"_GMRCURG,ND=ND+1
.S GMRCSX="" K GMRCSY
.Q
S @GLOBAL@(ND,0)="~DSTID",ND=ND+1
I $G(GMRCDSID) S @GLOBAL@(ND,0)="d"_"^"_GMRCDSID,ND=ND+1
E S @GLOBAL@(ND,0)="d^^",ND=ND+1
;Get reason for request
S @GLOBAL@(ND,0)="~REASON",ND=ND+1
I $O(^GMR(123,+GMRCO,20,0)) S NDX=0 F S NDX=$O(^GMR(123,+GMRCO,20,NDX)) Q:NDX="" S @GLOBAL@(ND,0)="t"_^GMR(123,+GMRCO,20,NDX,0),ND=ND+1
E S @GLOBAL@(ND,0)="~REASON",ND=ND+1,@GLOBAL@(ND,0)="tREASON "
;Get Comments, including Deny Comments
D SENDCOMT^GMRCGUIU(GMRCO,.ND)
D GUIC^GMRCGUIU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCGUIC 10599 printed Apr 09, 2024@20:51:59 Page 2
GMRCGUIC ;SLC/DCM,JFR - GUI actions for editing consults; 3/13/03 12:21 ;Sep 14, 2020@11:26:29
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4,12,20,15,22,33,66,73,85,81,145**;DEC 27, 1997;Build 18
+2 ;
+3 ; This routine invokes IA #2698 (ORD(101.42)), #872(ORD(101)), #2713 (ORB3F1), #2051 (FIND1^DIC)
+4 ; #2053 (DIE), #2056 (GET1^DIQ), #2690 (ORB3FUP1), #5679 (LEXU), #10103 (XLFDT), #10104 (XLFSTR), #5747 (ICDEX)
+5 ;
RFQ(GMRCO,MSG,ND,NOW) ;File Reason For Request field 20
+1 NEW GMRCND,GMRCNT
+2 SET GMRCND=$ORDER(^GMR(123,GMRCO,20,0))
IF GMRCND=""
SET GMRCFLD(20)="Reason For Request: No Previous Value^20"
QUIT
+3 MERGE ^TMP("GMRCFLD20",$JOB,20)=^GMR(123,GMRCO,20)
+4 SET GMRCFLD(20)=$NAME(^TMP("GMRCFLD20",$JOB,20))
+5 KILL ^GMR(123,GMRCO,20)
+6 SET ^GMR(123,GMRCO,20,0)="^^^^"_DT_"^"
+7 SET GMRCND=""
SET GMRCNT=1
FOR
SET GMRCND=$ORDER(@MSG@(ND,GMRCND))
if GMRCND=""
QUIT
SET ^GMR(123,GMRCO,20,GMRCNT,0)=@MSG@(ND,GMRCND)
SET GMRCNT=GMRCNT+1
+8 SET $PIECE(^GMR(123,GMRCO,20,0),"^",3)=GMRCNT-1
SET $PIECE(^(0),"^",4)=GMRCNT-1
+9 QUIT
FILE(GMRCO,MSG,GMRCLM) ;File Edit changes
+1 ;GMRCO=Record IEN, GMRCCOM=Comment Array
+2 ;MSG=^TMP global where the data resides, i.e., MSG="^TMP(""GMRCR"",$J)"
+3 ; Data is stored in subscripted nodes: ^TMP("GMRCR",$J,1)="GMRCSS^2"
+4 ; Word processing data is stored in second subscripted node:
+5 ; ^TMP("GMRCR",$J,9,1)="This is word processing data."
+6 ;GMRCSS=To Service GMRCPROC=procedure/Request Type
+7 ;GMRCURG=Urgency GMRCPL=Place Of Consultation
+8 ;GMRCATN=Attention To GMRCINO=Service is In/Out Patient
+9 ;GMRCDIAG=Provisional Diagnosis .GMRCRFQ=Reason For Request array
+10 ;GMRCREQ=Procedure or Request; i.e., GMRCRQT=1727=^ORD(101,1727,0)='Procedure';GMRCRQT=1296=^ORD(101,1296,0)='Consult'
+11 ;GMRCITM=Item ordered for field .1 (stored in ^GMR(123,GMRCO,1.11,
+12 ;GMRCLM=coming from List Manager instead of the GUI
+13 ;GMRCERDT=Clinically Indicated Date GMRCDSID=DST ID
+14 ;GMRCCSYS=coding system for provisional dx GMRCDXDT=Date of provisional dx GMRCLABL=label applied to dx code for display purposes e.g. "ICD-9-CM"
+15 ;
+16 IF '$DATA(GMRCO)!('+GMRCO)
QUIT
+17 NEW GMRCSS,GMRCPROC,GMRCURG,GMRCPL,GMRCATN,GMRCRQT
+18 NEW GMRCION,GMRCDIAG,GMRCDXCD,GMRCACTN,GMRCERDT,GMRCCSYS,GMRCDXDT,GMRCLABL,CODINTXT,GMRCDSID
+19 SET GMRCDT=$$NOW^XLFDT
+20 SET GMRCMSG=""
SET GMRCNOD=0
+21 FOR
SET GMRCNOD=$ORDER(@MSG@(GMRCNOD))
if GMRCNOD=""
QUIT
SET GMRCMSG=@MSG@(GMRCNOD)
Begin DoDot:1
+22 IF $PIECE(GMRCMSG,"^",1)="COMMENT"
DO COMMENT^GMRCGUIU(GMRCO,MSG,GMRCNOD,$PIECE(GMRCMSG,"^",2))
QUIT
+23 IF $PIECE(GMRCMSG,"^",1)="GMRCRFQ"
DO RFQ(GMRCO,MSG,GMRCNOD,GMRCDT)
QUIT
+24 IF $PIECE(GMRCMSG,"^",1)="GMRCSS"
SET GMRCSS=$PIECE(GMRCMSG,"^",2)
SET GMRCFLD(1)=$PIECE(^GMR(123.5,$PIECE(^GMR(123,GMRCO,0),"^",5),0),"^",1)_"^1"
QUIT
+25 IF $PIECE(GMRCMSG,"^",1)="GMRCITM"
SET GMRCITM=$PIECE(GMRCMSG,"^",2)
SET GMRCFLD(.1)=^GMR(123,GMRCO,1.11)_"^.1"
QUIT
+26 ;S GMRCFLD(4)=+$P(^GMR(123,+GMRCO,0),"^",8)_"^4" D Q ;ignore procedure, can't be changed currently
IF $PIECE(GMRCMSG,"^",1)="GMRCPROC"
QUIT
+27 ; ..S GMRCPROC=$P(GMRCMSG,"^",2) I $L($P(^GMR(123,GMRCO,0),"^",8)),$P(GMRCMSG,"^",2)="" S GMRCPROC="DELETE"
+28 IF $PIECE(GMRCMSG,"^",1)="GMRCURG"
SET GMRCURG=$PIECE(GMRCMSG,"^",2)
SET GMRCFLD(5)=$SELECT(+$PIECE(^GMR(123,+GMRCO,0),"^",9):$PIECE(^ORD(101,+$PIECE(^GMR(123,+GMRCO,0),"^",9),0),"^",2),1:"")_"^"_$PIECE(^GMR(123,+GMRCO,0),"^",9)
QUIT
+29 IF $PIECE(GMRCMSG,"^",1)="GMRCPL"
Begin DoDot:2
+30 SET GMRCPL=$PIECE(GMRCMSG,"^",2)
IF '+GMRCPL
Begin DoDot:3
+31 SET GMRCPL="GMRCPLACE - "_$SELECT(GMRCPL="C":"ON CALL",GMRCPL="B":"BEDSIDE",GMRCPL="E":"EMERGENCY ROOM",1:GMRCPL)
SET GMRCPL=$ORDER(^ORD(101,"B",GMRCPL,0))
End DoDot:3
+32 SET GMRCFLD(6)=$SELECT(+$PIECE(^GMR(123,+GMRCO,0),"^",10):$PIECE($PIECE(^ORD(101,+$PIECE(^GMR(123,+GMRCO,0),"^",10),0),"^",1)," - ",2),1:"")_"^6"
+33 QUIT
End DoDot:2
QUIT
+34 IF $PIECE(GMRCMSG,"^",1)="GMRCATN"
SET GMRCATN=$PIECE(GMRCMSG,"^",2)
SET GMRCFLD(7)=$SELECT(+$PIECE(^GMR(123,+GMRCO,0),"^",11):$$GET1^DIQ(200,+$PIECE(^GMR(123,+GMRCO,0),"^",11),.01),1:"")_"^7"
QUIT
+35 IF $PIECE(GMRCMSG,"^",1)="GMRCREQ"
SET GMRCREQ=$PIECE(GMRCMSG,"^",2)
SET GMRCFLD(13)=$SELECT($PIECE(^GMR(123,+GMRCO,0),"^",17)="P":"Procedure",1:"Consult")_"^13"
QUIT
+36 IF $PIECE(GMRCMSG,"^",1)="GMRCION"
SET GMRCION=$PIECE(GMRCMSG,"^",2)
SET GMRCFLD(14)=$SELECT($PIECE(^GMR(123,+GMRCO,0),"^",18)="I":"Inpatient",$PIECE(^(0),"^",18)="O":"Outpatient",1:"")_"^14"
QUIT
+37 IF $PIECE(GMRCMSG,"^",1)="GMRCERDT"
SET GMRCERDT=$PIECE(GMRCMSG,"^",2)
SET GMRCFLD(17)=$SELECT(+$PIECE(^GMR(123,+GMRCO,0),"^",24)>0:$$FMTE^XLFDT($PIECE(^GMR(123,+GMRCO,0),"^",24)),1:"")_"^17"
QUIT
+38 IF $PIECE(GMRCMSG,"^",1)="GMRCDSID"
Begin DoDot:2
+39 if $DATA(^GMR(123,+GMRCO,75))
SET GMRCDSID=$PIECE(GMRCMSG,"^",2)
SET GMRCFLD(85)=$SELECT(^GMR(123,+GMRCO,75)>0:^GMR(123,+GMRCO,75),1:"")_"^85"
+40 if '$DATA(^GMR(123,+GMRCO,75))
SET GMRCDSID=$PIECE(GMRCMSG,"^",2)
SET GMRCFLD(85)=GMRCDSID_"^85"
End DoDot:2
QUIT
+41 IF $PIECE(GMRCMSG,"^",1)="GMRCDIAG"
Begin DoDot:2
+42 SET GMRCDIAG=$PIECE(GMRCMSG,"^",2)
+43 SET GMRCFLD(30)=$GET(^GMR(123,+GMRCO,30))_"^30"
+44 IF $PIECE(GMRCFLD(30),U)=""
SET $PIECE(GMRCFLD(30),U)="No Previous Value"
+45 IF $LENGTH($PIECE(GMRCMSG,U,3))
Begin DoDot:3
+46 SET GMRCDXCD=$PIECE(GMRCMSG,"^",3)
+47 SET GMRCCSYS=$$CODECS^ICDEX($GET(GMRCDXCD),80)
SET GMRCCSYS=$SELECT($PIECE(GMRCCSYS,U)=1:"ICD",$PIECE(GMRCCSYS,U)=30:"10D",1:"")
+48 SET GMRCLABL=$PIECE($GET(^GMR(123,+GMRCO,30.1)),U,3)
+49 SET GMRCLABL=$SELECT($GET(GMRCLABL)="ICD":"ICD-9-CM",$GET(GMRCLABL)="10D":"ICD-10-CM",1:"")
+50 SET GMRCFLD(30.1)=$PIECE($GET(^GMR(123,+GMRCO,30.1)),U)_"("_$GET(GMRCLABL)_")"_"^30.1"
+51 SET GMRCDXDT=$PIECE($GET(^GMR(123,+GMRCO,30.1)),U,2)
+52 if $GET(GMRCDXDT)=""
SET GMRCFLD(30.2)="No Previous Value"_"^30.2"
+53 if DT>+$GET(GMRCDXDT)
SET GMRCFLD(30.2)=$$FMTE^XLFDT(GMRCDXDT,"D")_"^30.2"
+54 IF GMRCCSYS'=$PIECE($GET(^GMR(123,+GMRCO,30.1)),U,3)
SET GMRCFLD(30.3)=$SELECT($PIECE($GET(^GMR(123,+GMRCO,30.1)),U,3)="ICD":"ICD-9-CM",$PIECE($GET(^GMR(123,+GMRCO,30.1)),U,3)="10D":"ICD-10-CM",1:"")_"^30.3"
End DoDot:3
+55 IF $GET(GMRCDXCD)'=""
SET CODINTXT="("_GMRCDXCD_")"
Begin DoDot:3
+56 IF GMRCDIAG[CODINTXT
SET GMRCDIAG=$EXTRACT(GMRCDIAG,0,($LENGTH(GMRCDIAG)-$LENGTH(CODINTXT)))
SET GMRCDIAG=$$TRIM^XLFSTR(GMRCDIAG,"R")
End DoDot:3
End DoDot:2
QUIT
+57 QUIT
End DoDot:1
+58 if '$DATA(GMRCLM)
SET GMRCGUIF=1
+59 SET GMRCACTN=$$EN^GMRCEDT3(GMRCO)
+60 SET DR=$$SETDA^GMRCGUIU($GET(GMRCSS),$GET(GMRCPROC),$GET(GMRCURG),$GET(GMRCPL),$GET(GMRCATN),$GET(GMRCRQT),$GET(GMRCION),$GET(GMRCERDT),$GET(GMRCDIAG),$GET(GMRCDXCD),$GET(GMRCDSID))
IF $LENGTH(DR)
Begin DoDot:1
+61 SET DIE="^GMR(123,"
SET DA=GMRCO
+62 ;WAT/66 added timeout
LOCK +^GMR(123,GMRCO):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
+63 DO ^DIE
+64 SET DR="8////^S X=5;9////^S X=11"
+65 DO ^DIE
+66 LOCK -^GMR(123,GMRCO)
+67 KILL DIE,DR,DA
+68 QUIT
End DoDot:1
+69 SET DFN=$PIECE(^GMR(123,+GMRCO,0),"^",2)
SET GMRCPROV=$PIECE(^(0),"^",14)
SET GMRCTYPE=$PIECE(^(0),"^",17)
SET GMRCTRLC="XX^RESUBMIT"
SET VISIT=""
SET RMBED=""
+70 DO EN^GMRCHL7(DFN,+GMRCO,GMRCTYPE,RMBED,GMRCTRLC,$GET(DUZ),VISIT,.GMRCOM)
+71 SET GMRCSVC=$SELECT($GET(GMRCSS):GMRCSS,1:$PIECE(^GMR(123,+GMRCO,0),U,5))
+72 SET GMRCORTX="Resubmitted consult "_$$ORTX^GMRCAU(+GMRCO)
+73 SET GMRCORTX=GMRCORTX_$SELECT($GET(GMRCURG):" ("_$PIECE(^ORD(101,+GMRCURG,0),"^",2)_")",+$PIECE(^GMR(123,+GMRCO,0),U,9):"( "_$PIECE(^ORD(101,+$PIECE(^GMR(123,+GMRCO,0),U,9),0),"^",2)_" )",1:"")
+74 SET GMRCFL=1
+75 ;Send notification of NEW consult
DO MSG^GMRCP(DFN,GMRCORTX,+GMRCO,27,.GMRCADUZ,GMRCFL)
+76 ;send 513 to service
DO PRNT^GMRCUTL1(+$PIECE(^GMR(123,+GMRCO,0),U,5),+GMRCO)
+77 ;Next line gets rid of alert
+78 IF $DATA(XQAID)
IF $LENGTH(XQAID)
Begin DoDot:1
+79 NEW GMRCCORY
+80 SET XQAKILL=$$XQAKILL^ORB3F1
DO DEL^ORB3FUP1(.GMRCCORY,XQAID)
End DoDot:1
+81 IF $PIECE($GET(^GMR(123,+GMRCO,12)),U,5)="P"
Begin DoDot:1
+82 DO TRIGR^GMRCIEVT(GMRCO,GMRCACTN)
End DoDot:1
+83 DO GUIC^GMRCGUIU
+84 QUIT
SEND(GMRCO,GLOBAL) ;Get data fields to send to GUI for editing consult
+1 ;GMRCO=record being edited GLOBAL=Global Referece, i.e., "^TMP("GMRCR",$J)"
+2 KILL @GLOBAL
+3 NEW ND,GMRCSX,TYPE,NDX,GMRCCPTR,GMRCCSYS,GMRCCODE,CODINTXT
+4 SET ND=1
SET GMRCSX=""
+5 IF '$DATA(GMRCO)!('+GMRCO)
QUIT
+6 SET GMRC(0)=$GET(^GMR(123,+GMRCO,0))
if '$LENGTH(GMRC(0))
QUIT
+7 SET GMRCSS=$PIECE(GMRC(0),"^",5)
SET GMRCPROC=$PIECE(GMRC(0),"^",8)
+8 SET GMRCURG=$PIECE(GMRC(0),"^",9)
SET GMRCPL=$PIECE(GMRC(0),"^",10)
+9 SET GMRCATN=$PIECE(GMRC(0),"^",11)
SET GMRCINO=$PIECE(GMRC(0),"^",18)
+10 SET GMRCREQ=$PIECE(GMRC(0),"^",17)
SET GMRCERDT=$PIECE(GMRC(0),"^",24)
+11 if $DATA(^GMR(123,+GMRCO,75))
SET GMRCDSID=$PIECE(^GMR(123,+GMRCO,75),U)
+12 SET GMRCDIAG=$GET(^GMR(123,+GMRCO,30))
IF $LENGTH($GET(^(30.1)))
Begin DoDot:1
+13 SET GMRCCODE=$PIECE($GET(^GMR(123,+GMRCO,30.1)),"^",1)
+14 SET GMRCCSYS=$PIECE($GET(^GMR(123,+GMRCO,30.1)),"^",3)
+15 SET GMRCCPTR=$SELECT(GMRCCSYS="ICD":1,1:30)
+16 ;users expect to see prov dx text and dx code in edit/resubmit dialog
IF $GET(GMRCCODE)'=""
Begin DoDot:2
+17 SET CODINTXT=" ("_GMRCCODE_")"
+18 if GMRCDIAG[CODINTXT
QUIT
+19 SET GMRCDIAG=GMRCDIAG_CODINTXT
End DoDot:2
+20 SET GMRCDIAG=GMRCDIAG_U_$GET(GMRCCODE)
End DoDot:1
+21 SET GMRCPROV=$SELECT($PIECE(^GMR(123,+GMRCO,0),U,14):$$GET1^DIQ(200,+$PIECE(^(0),U,14),.01),1:"")
+22 SET @GLOBAL@(ND,0)="~SERVICE"
SET ND=ND+1
+23 IF +GMRCSS
SET GMRCSX=$PIECE(^GMR(123.5,GMRCSS,0),"^",1)
SET @GLOBAL@(ND,0)="d"_GMRCSX_"^"_GMRCSS_"^"
SET ND=ND+1
SET GMRCSX=""
+24 IF '$TEST
SET @GLOBAL@(ND,0)="d"_"^^"
SET ND=ND+1
+25 SET @GLOBAL@(ND,0)="~PROCEDURE"
SET ND=ND+1
+26 IF $LENGTH(GMRCPROC)
IF +GMRCPROC
Begin DoDot:1
+27 SET GMRCSX=$$UP^XLFSTR($$GET1^DIQ(123.3,+GMRCPROC,.01))
+28 SET GMRCSY=$$FIND1^DIC(101.43,,"QX",+GMRCPROC_";99PRC","ID")
+29 IF +GMRCSY
Begin DoDot:2
+30 SET @GLOBAL@(ND,0)="d"_GMRCSY_"^"_GMRCSX
SET ND=ND+1
+31 QUIT
End DoDot:2
End DoDot:1
+32 IF '$TEST
SET @GLOBAL@(ND,0)="d^^"
+33 SET @GLOBAL@(ND,0)="~TYPE"
SET ND=ND+1
+34 IF $LENGTH(GMRCREQ)
Begin DoDot:1
+35 SET GMRCSX=$SELECT(GMRCREQ="P":"PROCEDURE",1:"CONSULT")
+36 SET @GLOBAL@(ND,0)="d"_$EXTRACT(GMRCSX,1)_"^"_GMRCSX_"^"_GMRCREQ
+37 SET GMRCSX=""
End DoDot:1
IF '$LENGTH(GMRCREQ)
SET @GLOBAL@(ND,0)="d^^"
+38 SET ND=ND+1
+39 SET @GLOBAL@(ND,0)="~CATEGORY"
SET ND=ND+1
+40 IF $LENGTH(GMRCINO)
Begin DoDot:1
+41 SET @GLOBAL@(ND,0)="d"_GMRCINO_"^"_$SELECT(GMRCINO="I":"INPATIENT",1:"OUTPATIENT")_"^"
+42 SET @GLOBAL@(ND,0)=@GLOBAL@(ND,0)_$SELECT(GMRCINO="I":$ORDER(^ORD(101,"B","GMRCURGENCYM CSLT - INPATIENT",0)),1:$ORDER(^ORD(101,"B","GMRCURGENCYM - OUTPATIENT",0)))
+43 QUIT
End DoDot:1
SET ND=ND+1
SET GMRCSX=""
+44 IF '$TEST
SET @GLOBAL@(ND,0)="d^^"
+45 SET @GLOBAL@(ND,0)="~DIAGNOSIS"
SET ND=ND+1
+46 IF $LENGTH(GMRCDIAG)
SET @GLOBAL@(ND,0)="d"_GMRCDIAG
SET ND=ND+1
+47 IF '$TEST
SET @GLOBAL@(ND,0)="d"
+48 SET @GLOBAL@(ND,0)="~PLACE"
SET ND=ND+1
+49 IF +GMRCPL
Begin DoDot:1
+50 SET GMRCSX=$PIECE($PIECE(^ORD(101,GMRCPL,0),"^",1),"GMRCPLACE - ",2)
SET GMRCSX=$SELECT(GMRCSX="ON CALL":"CONSULTANTS CHOICE",1:GMRCSX)
SET @GLOBAL@(ND,0)="d"_$EXTRACT(GMRCSX,1)_"^"_GMRCSX_"^"_GMRCPL
+51 QUIT
End DoDot:1
SET ND=ND+1
SET GMRCSX=""
+52 IF '$TEST
SET @GLOBAL@(ND,0)="d^^"
SET ND=ND+1
+53 SET @GLOBAL@(ND,0)="~ATTENTION"
SET ND=ND+1
+54 IF +GMRCATN
SET GMRCSX=$$GET1^DIQ(200,GMRCATN,.01)
SET @GLOBAL@(ND,0)="d"_GMRCATN_"^"_GMRCSX_"^"_GMRCATN
SET ND=ND+1
SET GMRCSX=""
+55 IF '$TEST
SET @GLOBAL@(ND,0)="d^^"
SET ND=ND+1
+56 SET @GLOBAL@(ND,0)="~CLINICALLY"
SET ND=ND+1
+57 IF GMRCERDT
SET @GLOBAL@(ND,0)="d"_"^"_GMRCERDT
SET ND=ND+1
+58 IF '$TEST
SET @GLOBAL@(ND,0)="d^"
+59 SET @GLOBAL@(ND,0)="~URGENCY"
SET ND=ND+1
+60 IF +GMRCURG
SET GMRCSX=$PIECE($PIECE(^ORD(101,GMRCURG,0),"^",1),"GMRCURGENCY - ",2)
SET GMRCURGY=$ORDER(^ORD(101.42,"S.GMRCO",GMRCSX,0))
IF $LENGTH(GMRCSX)
Begin DoDot:1
+61 SET GMRCSY=$ORDER(^ORD(101.42,"B",GMRCSX,0))
+62 SET @GLOBAL@(ND,0)="d"_GMRCSY_"^"_GMRCSX_"^"_GMRCURG
SET ND=ND+1
+63 SET GMRCSX=""
KILL GMRCSY
+64 QUIT
End DoDot:1
+65 SET @GLOBAL@(ND,0)="~DSTID"
SET ND=ND+1
+66 IF $GET(GMRCDSID)
SET @GLOBAL@(ND,0)="d"_"^"_GMRCDSID
SET ND=ND+1
+67 IF '$TEST
SET @GLOBAL@(ND,0)="d^^"
SET ND=ND+1
+68 ;Get reason for request
+69 SET @GLOBAL@(ND,0)="~REASON"
SET ND=ND+1
+70 IF $ORDER(^GMR(123,+GMRCO,20,0))
SET NDX=0
FOR
SET NDX=$ORDER(^GMR(123,+GMRCO,20,NDX))
if NDX=""
QUIT
SET @GLOBAL@(ND,0)="t"_^GMR(123,+GMRCO,20,NDX,0)
SET ND=ND+1
+71 IF '$TEST
SET @GLOBAL@(ND,0)="~REASON"
SET ND=ND+1
SET @GLOBAL@(ND,0)="tREASON "
+72 ;Get Comments, including Deny Comments
+73 DO SENDCOMT^GMRCGUIU(GMRCO,.ND)
+74 DO GUIC^GMRCGUIU
+75 QUIT
