GMRCSLM2 ;SLC/DCM,WAT - LM Detailed display and printing ;05-Aug-2013 12:52;DU
;;3.0;CONSULT/REQUEST TRACKING;**1,4,18,15,17,23,22,65,1003,1004**;DEC 27,1997;Build 12
;
; This routine invokes IA #872 ^ORD(101 #875 ORDER STATUS file point #2467 $$OI^ORX8 #2638 ORDER STATUS file access
;#2056 $$GET1^DIQ #10104 XLFSTR #4156 $$CVEDT^DGCV #10117 ^VALM10 #2849 ORDERS file
;#10040 HOSPITAL LOCATION file #10060 NEW PERSON file
;
;Modified - IHS/MSC/PLS - 01/31/2012 - Line DT+21
;
DT(GMRCO,GMRCIERR) ;;Entry point to set-up detailed display.
;;Pass in GMRCO as +GMRCO - a number only. GMRCO=IEN from of consult from file 123
;;Results are placed in ^TMP("GMRCR",$J,"DT",
;;Pass in variable GMRCOER=2 if calling from the GUI, GMRCOER=1 if call is from CPRS consults tab
;;Pass in variable GMRCOER=0 (or as <UNDEFINED>) if call is from consults routines
K GMRCQUT
N DFN,GMRCD,GMRCDA,ORIFN,GMRCSF S GMRCDVDL="",$P(GMRCDVDL,"-",80)=""
I $S('GMRCO:1,'$D(^GMR(123,+GMRCO,0)):1,1:0) D:$S('$D(GMRCOER):1,'GMRCOER:1,1:0) S GMRCQUT=1 Q
.S GMRCMSG="The consult entry selected for the Detailed Display is unknown." D EXAC^GMRCADC(GMRCMSG) K GMRCMSG
.Q
K ^TMP("GMRCR",$J,"DT") S TAB="",$P(TAB," ",30)="",GMRCCT=1
S GMRCO(0)=^GMR(123,+GMRCO,0),ORIFN=$P(GMRCO(0),"^",3),DFN=$P(GMRCO(0),"^",2)
S X="SDUTL3" X ^%ZOSF("TEST") I D
.N PR S PR=$$OUTPTPR^SDUTL3(DFN) I $L(PR) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Current PC Provider: "_$P(PR,"^",2),GMRCCT=GMRCCT+1
.S PR=$$OUTPTTM^SDUTL3(DFN) I $L(PR) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Current PC Team: "_$P(PR,"^",2),GMRCCT=GMRCCT+1
.Q
N VAIN,VAEL,CVELIG
D INP^VADPT S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Current Pat. Status: "_$S(+VAIN(8):"Inpatient",1:"Outpatient"),GMRCCT=GMRCCT+1
I $D(VAIN(4)),$L($P(VAIN(4),"^",2)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ward:"_$E(TAB,1,18)_$P(VAIN(4),"^",2),GMRCCT=GMRCCT+1
D ELIG^VADPT
I $L($P(VAEL(1),"^",2)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Primary Eligibility:"_$E(TAB,1,11)_$P(VAEL(1),"^",2),GMRCCT=GMRCCT+1
;IHS/MSC/PLS - S CVELIG=$$CVEDT^DGCV(DFN) S:$P($G(CVELIG),U,3) ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Combat Vet Eligible:"_$E(TAB,1,11)_"YES",GMRCCT=GMRCCT+1 ;WAT gmrc,65
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Order Information",GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="To Service:"_$E(TAB,1,12)_$P($G(^GMR(123.5,+$P(GMRCO(0),"^",5),0)),"^"),GMRCCT=GMRCCT+1
I $P(GMRCO(0),"^",11) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Attention:"_$E(TAB,1,13)_$$GET1^DIQ(200,$P($G(GMRCO(0)),"^",11),.01),GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="From Service:"_$E(TAB,1,10)_$P($G(^SC(+$P(GMRCO(0),"^",6),0)),"^"),GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Requesting Provider: "_$E(TAB,1,2)_$S($P(GMRCO(0),"^",14)]"":$$GET1^DIQ(200,$P($G(GMRCO(0)),"^",14),.01),1:""),GMRCCT=GMRCCT+1
I $L($P(GMRCO(0),"^",18)) D
.S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Service is to be rendered on an "_$S($P(GMRCO(0),"^",18)="I":"INPATIENT",1:"OUTPATIENT")_" basis",GMRCCT=GMRCCT+1
.Q
I $P(GMRCO(0),"^",10) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Place:"_$E(TAB,1,17)_$P($G(^ORD(101,+$P(GMRCO(0),"^",10),0)),"^",2),GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Urgency:"_$E(TAB,1,15)_$S($L($P(GMRCO(0),"^",9)):$P($G(^ORD(101,+$P(GMRCO(0),"^",9),0)),"^",2),1:""),GMRCCT=GMRCCT+1
S X="ORX8" X ^%ZOSF("TEST") I D
.N GMRCOITM S GMRCOITM=$$OI^ORX8(ORIFN)
.S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Orderable Item:"_$E(TAB,1,8)_$P(GMRCOITM,U,2),GMRCCT=GMRCCT+1
.Q
S GMRCPRNM=$P(GMRCO(0),"^",8),GMRCPROC=$S(+GMRCPRNM:$P($G(^GMR(123.3,+GMRCPRNM,0)),"^"),1:"Consult Request")
I $L(GMRCPROC) D
.N GMRCLN
.S GMRCTYPE=$S($P(GMRCO(0),U,17)="P":"Procedure",1:"Consult")
.S GMRCLN=GMRCTYPE_":"_$E(TAB,1,22-$L(GMRCTYPE))_GMRCPROC
.S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCLN
.S GMRCCT=GMRCCT+1
.I $G(^GMR(123,+GMRCO,1)) D
.. S GMRCLN=""
.. S GMRCLN="Clinical Procedure:"_$E(TAB,1,4)
.. S GMRCLN=GMRCLN_$$GET1^DIQ(123,+GMRCO,1.01,"E")
.. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCLN
.. S GMRCCT=GMRCCT+1
.Q
S GMRCD=$G(^GMR(123,+GMRCO,30)) I $L(GMRCD) D
. I $L(GMRCD)>54 D
.. N SEG,I S I=2
.. F S SEG=$P(GMRCD," ",1,I) Q:$L(SEG)>54 S I=I+1
.. S SEG=$P(GMRCD," ",1,(I-1))
.. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Provisional Diagnosis: "_SEG
.. S GMRCCT=GMRCCT+1
.. S SEG=$$REPEAT^XLFSTR(" ",22)_$E(GMRCD,$L(SEG)+1,80)
.. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=SEG S GMRCD=""
.. S GMRCCT=GMRCCT+1
I GMRCD'="" D
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Provisional Diagnosis: "_GMRCD
. S GMRCCT=GMRCCT+1
I $D(^GMR(123,+GMRCO,20,0)) D
.I $O(^GMR(123,+GMRCO,20,0)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Reason For Request:",GMRCCT=GMRCCT+1 D Q
.. S LN=0
.. F S LN=$O(^GMR(123,+GMRCO,20,LN)) Q:LN="" D
... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=^GMR(123,+GMRCO,20,LN,0)
... I $G(GMRCIERR) D
.... N TXT S TXT=^TMP("GMRCR",$J,"DT",GMRCCT,0)_"..."
.... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=TXT
.... S LN=9999 ;quit with just one line
... S GMRCCT=GMRCCT+1
.. Q
. Q
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=" ",GMRCCT=GMRCCT+1
N TXT,SNOTXT,SNO,PROB,PROBTXT,PROBIEN
S (SNOTXT,PROBTXT)=""
;IHS/MSC/MGH Patch 1004
I $D(^GMR(123,+GMRCO,9999999)) D
.S SNO=$P($G(^GMR(123,+GMRCO,9999999)),U,1)
.S PROBIEN=$P($G(^GMR(123,+GMRCO,9999999)),U,2)
.I SNO'="" D
..S SNOTXT=$$CONC^BSTSAPI(SNO_"^30^^1")
..S TXT="Snomed: "_$P(SNOTXT,U,4)_" ("_SNO_")"
..S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=TXT,GMRCCT=GMRCCT+1
.I PROBIEN'="" D
..S PROB=$$GET1^DIQ(9000011,PROBIEN,80002)
..S PROBTXT=$$GET1^DIQ(9000011,PROBIEN,.05)
..S TXT="Associated Problem: "_PROBTXT_" ("_PROB_")"
..S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=TXT,GMRCCT=GMRCCT+1
;end mods patch 1004
; get inter-facility consult info
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Inter-facility Information",GMRCCT=GMRCCT+1
I '$P(GMRCO(0),"^",23) D
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="This is not an inter-facility consult request.",GMRCCT=GMRCCT+1
E D
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$$REPEAT^XLFSTR("-",27)
. S GMRCCT=GMRCCT+1
. N GMRCOP
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Remote Facility:"_$E(TAB,1,6)_$P($G(^DIC(4,+$P(GMRCO(0),"^",23),0)),"^"),GMRCCT=GMRCCT+1
. S GMRCO(12)=$G(^GMR(123,+GMRCO,12))
. I $L($P(GMRCO(12),U,6)) D
.. S GMRCOP=$P(GMRCO(12),U,6)
. I '$D(GMRCOP) S GMRCOP=$$GET1^DIQ(200,+$P(GMRCO(0),U,14),.01)
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ordering Provider:"_$E(TAB,1,5)_GMRCOP,GMRCCT=GMRCCT+1
. S GMRCO(13)=$G(^GMR(123,+GMRCO,13)) I $L($P(GMRCO(13),U,2,3))>1 D
.. N LINE
.. S LINE=$P(GMRCO(13),U,2) I $L(LINE) S LINE=LINE_$E(TAB,1,5) D
... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ordering Provider phone: "_LINE
... S GMRCCT=GMRCCT+1
.. S LINE=$P(GMRCO(13),U,3) I $L(LINE) S LINE=LINE_$E(TAB,1,5) D
... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ordering Provider pager: "_LINE
... S GMRCCT=GMRCCT+1
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Remote Consult #"_$E(TAB)_$P(GMRCO(0),"^",22),GMRCCT=GMRCCT+1
. I $L($P(GMRCO(13),U)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Remote Service name: "_$E(TAB)_$P(GMRCO(13),U),GMRCCT=GMRCCT+1
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Role: "_$E(TAB,1,10)_$S($P(GMRCO(12),U,5)="P":"Requesting facility",1:"Consulting facility"),GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
;get status, last action, and significant findings
S STS=$P(GMRCO(0),"^",12),^TMP("GMRCR",$J,"DT",GMRCCT,0)="Status: "_$E(TAB,1,14)_$S($D(^ORD(100.01,+STS,0)):$P(^(0),"^",1),1:$P(^ORD(100.01,6,0),"^",1)),GMRCCT=GMRCCT+1
S GMRCA=$P(^GMR(123,+GMRCO,0),"^",13),^TMP("GMRCR",$J,"DT",GMRCCT,0)="Last Action:"_$E(TAB,1,11)_$S(+GMRCA:$P($G(^GMR(123.1,GMRCA,0)),"^",1),1:""),GMRCCT=GMRCCT+1
I $L($P(GMRCO(0),"^",19)) D
.S GMRCSF=$P(GMRCO(0),"^",19)
.S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Significant Findings: "_$S(GMRCSF="Y":"YES",GMRCSF="N":"NO",1:"Unknown")
.S GMRCCT=GMRCCT+1
.Q
;IHS/MSC/MGH SNOMEDS added for MU stage 2
N I,CLOSED,IN,OUT,ARR,BY,WHEN,X,TXT,AIEN
I $D(^GMR(123,+GMRCO,9999999.11,0)) D
.S I=0 F S I=$O(^GMR(123,+GMRCO,9999999.11,I)) Q:I="" D
..S AIEN=I_","_+GMRCO_","
..S CLOSED=$$GET1^DIQ(123.999999911,AIEN,.01)
..S BY=$$GET1^DIQ(123.999999911,AIEN,1)
..S WHEN=$$GET1^DIQ(123.999999911,AIEN,2)
..S IN=CLOSED_"^30^^1"
..S OUT="ARR"
..S X=$$CNCLKP^BSTSAPI(.OUT,.IN)
..I X>0 D
...S TXT=@OUT@(1,"PRE","TRM")
...S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=" Closed Action: "_TXT_" ("_CLOSED_")",GMRCCT=GMRCCT+1
...S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=" On: "_WHEN_" By: "_BY,GMRCCT=GMRCCT+1
I $G(GMRCIERR) Q ;don't need results or activities on IFC errors
D ACTLOG^GMRCSLM4(+GMRCO)
; any inter-facility results?
I $P(GMRCO(0),"^",23) D
. N GMRCIFRS,X S GMRCIFRS=0,X=""
. F S X=$O(^GMR(123,GMRCO,51,"B",X)) Q:X="" S GMRCIFRS=GMRCIFRS+1
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Inter-facility Results: "_$S(GMRCIFRS>0:"Results are available via Display Results action.",1:"No results available for this consult request."),GMRCCT=GMRCCT+2
;get local results
D GETRSLT^GMRCART($NA(^TMP("GMRCRT",$J)),1)
N NXT S NXT=0
F S NXT=$O(^TMP("GMRCRT",$J,NXT)) Q:'NXT D
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$G(^TMP("GMRCRT",$J,NXT,0))
. S GMRCCT=GMRCCT+1
. Q
K ^TMP("GMRCRT",$J)
I $S('$D(GMRCOER):1,'GMRCOER:1,1:0),$D(VALMAR) D CLEAN^VALM10
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",$P(^(0),"=",80)="",^(0)=$E(^(0),1,36)_" END "_$E(^(0),43,80)
DTQ K X,LN,PL,TO,WP,FLG,SEX,STS,URG,WRD,BKLN,DATA,WRD,PROC,LINE,GMRC(0),GMRC(40),GMRCD,GMRCDVDL,GMRCO,GMRCAR,GMRCRB,GMRCLA,GMRCSR,GMRCTO,MCFILE,MCPROC,DSPLINE,GMRCLA1,GMRCPRNM,GMRCPROC,GMRCTYPE,GMRCWARD
I $D(GMRCOER),'GMRCOER D:$D(VALMEVL) KILL^VALM10() D:$D(VALMAR) CLEAN^VALM10
Q
GMRCSLM2 ;SLC/DCM,WAT - LM Detailed display and printing ;05-Aug-2013 12:52;DU
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,18,15,17,23,22,65,1003,1004**;DEC 27,1997;Build 12
+2 ;
+3 ; This routine invokes IA #872 ^ORD(101 #875 ORDER STATUS file point #2467 $$OI^ORX8 #2638 ORDER STATUS file access
+4 ;#2056 $$GET1^DIQ #10104 XLFSTR #4156 $$CVEDT^DGCV #10117 ^VALM10 #2849 ORDERS file
+5 ;#10040 HOSPITAL LOCATION file #10060 NEW PERSON file
+6 ;
+7 ;Modified - IHS/MSC/PLS - 01/31/2012 - Line DT+21
+8 ;
DT(GMRCO,GMRCIERR) ;;Entry point to set-up detailed display.
+1 ;;Pass in GMRCO as +GMRCO - a number only. GMRCO=IEN from of consult from file 123
+2 ;;Results are placed in ^TMP("GMRCR",$J,"DT",
+3 ;;Pass in variable GMRCOER=2 if calling from the GUI, GMRCOER=1 if call is from CPRS consults tab
+4 ;;Pass in variable GMRCOER=0 (or as <UNDEFINED>) if call is from consults routines
+5 KILL GMRCQUT
+6 NEW DFN,GMRCD,GMRCDA,ORIFN,GMRCSF
SET GMRCDVDL=""
SET $PIECE(GMRCDVDL,"-",80)=""
+7 IF $SELECT('GMRCO:1,'$DATA(^GMR(123,+GMRCO,0)):1,1:0)
IF $SELECT('$DATA(GMRCOER)
Begin DoDot:1
+8 SET GMRCMSG="The consult entry selected for the Detailed Display is unknown."
DO EXAC^GMRCADC(GMRCMSG)
KILL GMRCMSG
+9 QUIT
End DoDot:1
SET GMRCQUT=1
QUIT
+10 KILL ^TMP("GMRCR",$JOB,"DT")
SET TAB=""
SET $PIECE(TAB," ",30)=""
SET GMRCCT=1
+11 SET GMRCO(0)=^GMR(123,+GMRCO,0)
SET ORIFN=$PIECE(GMRCO(0),"^",3)
SET DFN=$PIECE(GMRCO(0),"^",2)
+12 SET X="SDUTL3"
XECUTE ^%ZOSF("TEST")
IF $TEST
Begin DoDot:1
+13 NEW PR
SET PR=$$OUTPTPR^SDUTL3(DFN)
IF $LENGTH(PR)
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Current PC Provider: "_$PIECE(PR,"^",2)
SET GMRCCT=GMRCCT+1
+14 SET PR=$$OUTPTTM^SDUTL3(DFN)
IF $LENGTH(PR)
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Current PC Team: "_$PIECE(PR,"^",2)
SET GMRCCT=GMRCCT+1
+15 QUIT
End DoDot:1
+16 NEW VAIN,VAEL,CVELIG
+17 DO INP^VADPT
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Current Pat. Status: "_$SELECT(+VAIN(8):"Inpatient",1:"Outpatient")
SET GMRCCT=GMRCCT+1
+18 IF $DATA(VAIN(4))
IF $LENGTH($PIECE(VAIN(4),"^",2))
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Ward:"_$EXTRACT(TAB,1,18)_$PIECE(VAIN(4),"^",2)
SET GMRCCT=GMRCCT+1
+19 DO ELIG^VADPT
+20 IF $LENGTH($PIECE(VAEL(1),"^",2))
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Primary Eligibility:"_$EXTRACT(TAB,1,11)_$PIECE(VAEL(1),"^",2)
SET GMRCCT=GMRCCT+1
+21 ;IHS/MSC/PLS - S CVELIG=$$CVEDT^DGCV(DFN) S:$P($G(CVELIG),U,3) ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Combat Vet Eligible:"_$E(TAB,1,11)_"YES",GMRCCT=GMRCCT+1 ;WAT gmrc,65
+22 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+23 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Order Information"
SET GMRCCT=GMRCCT+1
+24 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="To Service:"_$EXTRACT(TAB,1,12)_$PIECE($GET(^GMR(123.5,+$PIECE(GMRCO(0),"^",5),0)),"^")
SET GMRCCT=GMRCCT+1
+25 IF $PIECE(GMRCO(0),"^",11)
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Attention:"_$EXTRACT(TAB,1,13)_$$GET1^DIQ(200,$PIECE($GET(GMRCO(0)),"^",11),.01)
SET GMRCCT=GMRCCT+1
+26 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="From Service:"_$EXTRACT(TAB,1,10)_$PIECE($GET(^SC(+$PIECE(GMRCO(0),"^",6),0)),"^")
SET GMRCCT=GMRCCT+1
+27 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Requesting Provider: "_$EXTRACT(TAB,1,2)_$SELECT($PIECE(GMRCO(0),"^",14)]"":$$GET1^DIQ(200,$PIECE($GET(GMRCO(0)),"^",14),.01),1:"")
SET GMRCCT=GMRCCT+1
+28 IF $LENGTH($PIECE(GMRCO(0),"^",18))
Begin DoDot:1
+29 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Service is to be rendered on an "_$SELECT($PIECE(GMRCO(0),"^",18)="I":"INPATIENT",1:"OUTPATIENT")_" basis"
SET GMRCCT=GMRCCT+1
+30 QUIT
End DoDot:1
+31 IF $PIECE(GMRCO(0),"^",10)
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Place:"_$EXTRACT(TAB,1,17)_$PIECE($GET(^ORD(101,+$PIECE(GMRCO(0),"^",10),0)),"^",2)
SET GMRCCT=GMRCCT+1
+32 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Urgency:"_$EXTRACT(TAB,1,15)_$SELECT($LENGTH($PIECE(GMRCO(0),"^",9)):$PIECE($GET(^ORD(101,+$PIECE(GMRCO(0),"^",9),0)),"^",2),1:"")
SET GMRCCT=GMRCCT+1
+33 SET X="ORX8"
XECUTE ^%ZOSF("TEST")
IF $TEST
Begin DoDot:1
+34 NEW GMRCOITM
SET GMRCOITM=$$OI^ORX8(ORIFN)
+35 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Orderable Item:"_$EXTRACT(TAB,1,8)_$PIECE(GMRCOITM,U,2)
SET GMRCCT=GMRCCT+1
+36 QUIT
End DoDot:1
+37 SET GMRCPRNM=$PIECE(GMRCO(0),"^",8)
SET GMRCPROC=$SELECT(+GMRCPRNM:$PIECE($GET(^GMR(123.3,+GMRCPRNM,0)),"^"),1:"Consult Request")
+38 IF $LENGTH(GMRCPROC)
Begin DoDot:1
+39 NEW GMRCLN
+40 SET GMRCTYPE=$SELECT($PIECE(GMRCO(0),U,17)="P":"Procedure",1:"Consult")
+41 SET GMRCLN=GMRCTYPE_":"_$EXTRACT(TAB,1,22-$LENGTH(GMRCTYPE))_GMRCPROC
+42 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=GMRCLN
+43 SET GMRCCT=GMRCCT+1
+44 IF $GET(^GMR(123,+GMRCO,1))
Begin DoDot:2
+45 SET GMRCLN=""
+46 SET GMRCLN="Clinical Procedure:"_$EXTRACT(TAB,1,4)
+47 SET GMRCLN=GMRCLN_$$GET1^DIQ(123,+GMRCO,1.01,"E")
+48 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=GMRCLN
+49 SET GMRCCT=GMRCCT+1
End DoDot:2
+50 QUIT
End DoDot:1
+51 SET GMRCD=$GET(^GMR(123,+GMRCO,30))
IF $LENGTH(GMRCD)
Begin DoDot:1
+52 IF $LENGTH(GMRCD)>54
Begin DoDot:2
+53 NEW SEG,I
SET I=2
+54 FOR
SET SEG=$PIECE(GMRCD," ",1,I)
IF $LENGTH(SEG)>54
QUIT
SET I=I+1
+55 SET SEG=$PIECE(GMRCD," ",1,(I-1))
+56 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Provisional Diagnosis: "_SEG
+57 SET GMRCCT=GMRCCT+1
+58 SET SEG=$$REPEAT^XLFSTR(" ",22)_$EXTRACT(GMRCD,$LENGTH(SEG)+1,80)
+59 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=SEG
SET GMRCD=""
+60 SET GMRCCT=GMRCCT+1
End DoDot:2
End DoDot:1
+61 IF GMRCD'=""
Begin DoDot:1
+62 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Provisional Diagnosis: "_GMRCD
+63 SET GMRCCT=GMRCCT+1
End DoDot:1
+64 IF $DATA(^GMR(123,+GMRCO,20,0))
Begin DoDot:1
+65 IF $ORDER(^GMR(123,+GMRCO,20,0))
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Reason For Request:"
SET GMRCCT=GMRCCT+1
Begin DoDot:2
+66 SET LN=0
+67 FOR
SET LN=$ORDER(^GMR(123,+GMRCO,20,LN))
IF LN=""
QUIT
Begin DoDot:3
+68 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=^GMR(123,+GMRCO,20,LN,0)
+69 IF $GET(GMRCIERR)
Begin DoDot:4
+70 NEW TXT
SET TXT=^TMP("GMRCR",$JOB,"DT",GMRCCT,0)_"..."
+71 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=TXT
+72 ;quit with just one line
SET LN=9999
End DoDot:4
+73 SET GMRCCT=GMRCCT+1
End DoDot:3
+74 QUIT
End DoDot:2
QUIT
+75 QUIT
End DoDot:1
+76 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=" "
SET GMRCCT=GMRCCT+1
+77 NEW TXT,SNOTXT,SNO,PROB,PROBTXT,PROBIEN
+78 SET (SNOTXT,PROBTXT)=""
+79 ;IHS/MSC/MGH Patch 1004
+80 IF $DATA(^GMR(123,+GMRCO,9999999))
Begin DoDot:1
+81 SET SNO=$PIECE($GET(^GMR(123,+GMRCO,9999999)),U,1)
+82 SET PROBIEN=$PIECE($GET(^GMR(123,+GMRCO,9999999)),U,2)
+83 IF SNO'=""
Begin DoDot:2
+84 SET SNOTXT=$$CONC^BSTSAPI(SNO_"^30^^1")
+85 SET TXT="Snomed: "_$PIECE(SNOTXT,U,4)_" ("_SNO_")"
+86 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=TXT
SET GMRCCT=GMRCCT+1
End DoDot:2
+87 IF PROBIEN'=""
Begin DoDot:2
+88 SET PROB=$$GET1^DIQ(9000011,PROBIEN,80002)
+89 SET PROBTXT=$$GET1^DIQ(9000011,PROBIEN,.05)
+90 SET TXT="Associated Problem: "_PROBTXT_" ("_PROB_")"
+91 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=TXT
SET GMRCCT=GMRCCT+1
End DoDot:2
End DoDot:1
+92 ;end mods patch 1004
+93 ; get inter-facility consult info
+94 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Inter-facility Information"
SET GMRCCT=GMRCCT+1
+95 IF '$PIECE(GMRCO(0),"^",23)
Begin DoDot:1
+96 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="This is not an inter-facility consult request."
SET GMRCCT=GMRCCT+1
End DoDot:1
+97 IF '$TEST
Begin DoDot:1
+98 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=$$REPEAT^XLFSTR("-",27)
+99 SET GMRCCT=GMRCCT+1
+100 NEW GMRCOP
+101 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Remote Facility:"_$EXTRACT(TAB,1,6)_$PIECE($GET(^DIC(4,+$PIECE(GMRCO(0),"^",23),0)),"^")
SET GMRCCT=GMRCCT+1
+102 SET GMRCO(12)=$GET(^GMR(123,+GMRCO,12))
+103 IF $LENGTH($PIECE(GMRCO(12),U,6))
Begin DoDot:2
+104 SET GMRCOP=$PIECE(GMRCO(12),U,6)
End DoDot:2
+105 IF '$DATA(GMRCOP)
SET GMRCOP=$$GET1^DIQ(200,+$PIECE(GMRCO(0),U,14),.01)
+106 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Ordering Provider:"_$EXTRACT(TAB,1,5)_GMRCOP
SET GMRCCT=GMRCCT+1
+107 SET GMRCO(13)=$GET(^GMR(123,+GMRCO,13))
IF $LENGTH($PIECE(GMRCO(13),U,2,3))>1
Begin DoDot:2
+108 NEW LINE
+109 SET LINE=$PIECE(GMRCO(13),U,2)
IF $LENGTH(LINE)
SET LINE=LINE_$EXTRACT(TAB,1,5)
Begin DoDot:3
+110 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Ordering Provider phone: "_LINE
+111 SET GMRCCT=GMRCCT+1
End DoDot:3
+112 SET LINE=$PIECE(GMRCO(13),U,3)
IF $LENGTH(LINE)
SET LINE=LINE_$EXTRACT(TAB,1,5)
Begin DoDot:3
+113 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Ordering Provider pager: "_LINE
+114 SET GMRCCT=GMRCCT+1
End DoDot:3
End DoDot:2
+115 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Remote Consult #"_$EXTRACT(TAB)_$PIECE(GMRCO(0),"^",22)
SET GMRCCT=GMRCCT+1
+116 IF $LENGTH($PIECE(GMRCO(13),U))
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Remote Service name: "_$EXTRACT(TAB)_$PIECE(GMRCO(13),U)
SET GMRCCT=GMRCCT+1
+117 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Role: "_$EXTRACT(TAB,1,10)_$SELECT($PIECE(GMRCO(12),U,5)="P":"Requesting facility",1:"Consulting facility")
SET GMRCCT=GMRCCT+1
End DoDot:1
+118 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+119 ;get status, last action, and significant findings
+120 SET STS=$PIECE(GMRCO(0),"^",12)
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Status: "_$EXTRACT(TAB,1,14)_$SELECT($DATA(^ORD(100.01,+STS,0)):$PIECE(^(0),"^",1),1:$PIECE(^ORD(100.01,6,0),"^",1))
SET GMRCCT=GMRCCT+1
+121 SET GMRCA=$PIECE(^GMR(123,+GMRCO,0),"^",13)
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Last Action:"_$EXTRACT(TAB,1,11)_$SELECT(+GMRCA:$PIECE($GET(^GMR(123.1,GMRCA,0)),"^",1),1:"")
SET GMRCCT=GMRCCT+1
+122 IF $LENGTH($PIECE(GMRCO(0),"^",19))
Begin DoDot:1
+123 SET GMRCSF=$PIECE(GMRCO(0),"^",19)
+124 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Significant Findings: "_$SELECT(GMRCSF="Y":"YES",GMRCSF="N":"NO",1:"Unknown")
+125 SET GMRCCT=GMRCCT+1
+126 QUIT
End DoDot:1
+127 ;IHS/MSC/MGH SNOMEDS added for MU stage 2
+128 NEW I,CLOSED,IN,OUT,ARR,BY,WHEN,X,TXT,AIEN
+129 IF $DATA(^GMR(123,+GMRCO,9999999.11,0))
Begin DoDot:1
+130 SET I=0
FOR
SET I=$ORDER(^GMR(123,+GMRCO,9999999.11,I))
IF I=""
QUIT
Begin DoDot:2
+131 SET AIEN=I_","_+GMRCO_","
+132 SET CLOSED=$$GET1^DIQ(123.999999911,AIEN,.01)
+133 SET BY=$$GET1^DIQ(123.999999911,AIEN,1)
+134 SET WHEN=$$GET1^DIQ(123.999999911,AIEN,2)
+135 SET IN=CLOSED_"^30^^1"
+136 SET OUT="ARR"
+137 SET X=$$CNCLKP^BSTSAPI(.OUT,.IN)
+138 IF X>0
Begin DoDot:3
+139 SET TXT=@OUT@(1,"PRE","TRM")
+140 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=" Closed Action: "_TXT_" ("_CLOSED_")"
SET GMRCCT=GMRCCT+1
+141 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=" On: "_WHEN_" By: "_BY
SET GMRCCT=GMRCCT+1
End DoDot:3
End DoDot:2
End DoDot:1
+142 ;don't need results or activities on IFC errors
IF $GET(GMRCIERR)
QUIT
+143 DO ACTLOG^GMRCSLM4(+GMRCO)
+144 ; any inter-facility results?
+145 IF $PIECE(GMRCO(0),"^",23)
Begin DoDot:1
+146 NEW GMRCIFRS,X
SET GMRCIFRS=0
SET X=""
+147 FOR
SET X=$ORDER(^GMR(123,GMRCO,51,"B",X))
IF X=""
QUIT
SET GMRCIFRS=GMRCIFRS+1
+148 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+149 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Inter-facility Results: "_$SELECT(GMRCIFRS>0:"Results are available via Display Results action.",1:"No results available for this consult request.")
SET GMRCCT=GMRCCT+2
End DoDot:1
+150 ;get local results
+151 DO GETRSLT^GMRCART($NAME(^TMP("GMRCRT",$JOB)),1)
+152 NEW NXT
SET NXT=0
+153 FOR
SET NXT=$ORDER(^TMP("GMRCRT",$JOB,NXT))
IF 'NXT
QUIT
Begin DoDot:1
+154 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=$GET(^TMP("GMRCRT",$JOB,NXT,0))
+155 SET GMRCCT=GMRCCT+1
+156 QUIT
End DoDot:1
+157 KILL ^TMP("GMRCRT",$JOB)
+158 IF $SELECT('$DATA(GMRCOER):1,'GMRCOER:1,1:0)
IF $DATA(VALMAR)
DO CLEAN^VALM10
+159 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET $PIECE(^(0),"=",80)=""
SET ^(0)=$EXTRACT(^(0),1,36)_" END "_$EXTRACT(^(0),43,80)
DTQ KILL X,LN,PL,TO,WP,FLG,SEX,STS,URG,WRD,BKLN,DATA,WRD,PROC,LINE,GMRC(0),GMRC(40),GMRCD,GMRCDVDL,GMRCO,GMRCAR,GMRCRB,GMRCLA,GMRCSR,GMRCTO,MCFILE,MCPROC,DSPLINE,GMRCLA1,GMRCPRNM,GMRCPROC,GMRCTYPE,GMRCWARD
+1 IF $DATA(GMRCOER)
IF 'GMRCOER
IF $DATA(VALMEVL)
DO KILL^VALM10()
IF $DATA(VALMAR)
DO CLEAN^VALM10
+2 QUIT
