GMRCSLM2 ;SLC/DCM,WAT - LM Detailed display and printing ;Sep 10, 2020@14:20:28
;;3.0;CONSULT/REQUEST TRACKING;**1,4,18,15,17,23,22,65,66,73,81,110,145**;DEC 27,1997;Build 18
;
;ICRs
;GLOBALS/FILES
;#872 ^ORD(101 #875 ORDER STATUS file point(100.01) #2638 ORDER STATUS file access #2849 ORDERS file #10060 NEW PERSON (file 200) #10040 HOSPITAL LOCATION (^SC)
;#10090 INSTITUTION
;ROUTINES
;#2467 $$OI^ORX8 #2056 $$GET1^DIQ #10104 XLFSTR #4156 $$CVEDT^DGCV #10117 ^VALM10 #4807 RDIS^DGRPDB
;
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,GMRCUCID 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
S GMRCUCID=$$GET1^DIQ(123,+GMRCO,80) I GMRCUCID]"" S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="UCID:"_$E(TAB,1,23-$L("UCID:"))_GMRCUCID,GMRCCT=GMRCCT+1 ;110
D ELIG^VADPT
S:$L($P(VAEL(1),"^",2)) ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Primary Eligibility:"_$E(TAB,1,3)_$P(VAEL(1),"^",2)_$S(VAEL(8)']"":" (NOT VERIFIED)",1:"("_$P(VAEL(8),"^",2)_")"),GMRCCT=GMRCCT+1
;wat 66
I $L($P(VAEL(6),U,2)) D
.;if TYPE is Active Duty and VETERAN Y/N? is No, then call the pt Active Duty
.I $P(VAEL(6),U,1)=5&(VAEL(4)=0) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Patient Type:"_$E(TAB,1,10)_$P(VAEL(6),U,2),GMRCCT=GMRCCT+1
.E S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Patient Type:"_$E(TAB,1,10)_$P(VAEL(6),U,2),GMRCCT=GMRCCT+1
;//wat 66
S CVELIG=$$CVEDT^DGCV(DFN) S:$P($G(CVELIG),U,3) ^TMP("GMRCR",$J,"DT",GMRCCT,0)="CV Eligible:"_$E(TAB,1,11)_"YES",GMRCCT=GMRCCT+1 ;WAT
;wat 66
N VASV,OIFOEF S OIFOEF="NO" D SVC^VADPT S:(VASV(11)>0)!(VASV(12)>0)!(VASV(13)>0) OIFOEF="YES"
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="OEF/OIF: "_$E(TAB,1,14)_$G(OIFOEF),GMRCCT=GMRCCT+1
; GET SC RATINGS AND %
N INC,COND S INC=0
I $P(VAEL(3),U)=1 D
.S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
.S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Service Connection/Rated Disabilities",GMRCCT=GMRCCT+1
.I '$P(VAEL(3),U,2) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="SC Percent:"_$E(TAB,1,12)_"DATA NOT FOUND",GMRCCT=GMRCCT+1
.E S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="SC Percent:"_$E(TAB,1,12)_$P(VAEL(3),U,2)_"%",GMRCCT=GMRCCT+1
.D RDIS^DGRPDB(DFN,.GMRCRDIS) I $D(GMRCRDIS(1)) D
..F S INC=$O(GMRCRDIS(INC)) Q:INC="" D
...S COND=$$GET1^DIQ(31,$P(GMRCRDIS(INC),U),.01)
...S:$G(INC)=1 ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Rated Disabilities:"_$E(TAB,1,4)_$G(COND)_" ("_$P(GMRCRDIS(INC),U,2)_"%)",GMRCCT=GMRCCT+1
...S:$G(INC)>1 ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$E(TAB,1,23)_$G(COND)_" ("_$P(GMRCRDIS(INC),U,2)_"%)",GMRCCT=GMRCCT+1
.I '$D(GMRCRDIS) D
..S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Rated Disabilities:"_$E(TAB,1,4)_"NONE STATED",GMRCCT=GMRCCT+1
;//wat 66
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 ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Clinically Ind. Date:"_$E(TAB,1,2)_$$FMTE^XLFDT($P($G(GMRCO(0)),"^",24),1),GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="DST ID:"_$E(TAB,1,16)_$G(^GMR(123,+GMRCO,75)),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
D PROVDIAG(+GMRCO)
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
; 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)_$$GET1^DIQ(4,+$P(GMRCO(0),"^",23),.01),GMRCCT=GMRCCT+1 ;WAT/73
. 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
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,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
PROVDIAG(GMRCDA) ;test all prov diags
N GMRCD,GMRCCODE,PIECE,FLG,CODINTXT,BUFFER,REPEAT
S FLG=0
S REPEAT=22 ;spaces to repeat for formatting
S GMRCD=$G(^GMR(123,GMRCDA,30))
S GMRCCODE=$G(^GMR(123,GMRCDA,30.1)),CODINTXT="("_$P(GMRCCODE,U)_")"
;icd-9 consults stored code in diagnosis text, icd-10 does not. Strip code from text and append to end for display
;desired coding system and code display format (ICD-9-CM 123.45) or (ICD-10-CM S06.4X0S)
I GMRCD[$G(CODINTXT) D
.S GMRCD=$E(GMRCD,0,($L(GMRCD)-$L(CODINTXT)))
I $L($P(GMRCCODE,U))>0 D
.I $P(GMRCCODE,U,3)="ICD" S GMRCD=GMRCD_"(ICD-9-CM "_$P(GMRCCODE,U)_")"
.I $P(GMRCCODE,U,3)="10D" S GMRCD=GMRCD_"(ICD-10-CM "_$P(GMRCCODE,U)_")"
I $L($G(GMRCD))>54 D
.F S PIECE=$L(GMRCD) Q:PIECE<54 D ;$L of GMRCD will change below, so hold original length in PIECE
.. N SEG,I S I=2
.. F S SEG=$P(GMRCD," ",1,I) Q:$L(SEG)>=54!($L(SEG," ")<I) S I=I+1
.. I $L(SEG)=$L(GMRCD) S SEG=$E(GMRCD,1,54) ;means GMRCD doesn't contain spaces, e.g. v55,250.00,414.00,etc.
.. S BUFFER=SEG
.. S:SEG[" " SEG=$P(GMRCD," ",1,(I-1)) I $L(SEG)=0 S SEG=$E(BUFFER,1,54) ;$P only good when SEG contains a space, otherwise grab a SEG from BUFFER
.. S:FLG=0 ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Provisional Diagnosis: "_SEG
.. I FLG=1&($F(GMRCD," ")'=2) S REPEAT=23
.. S:FLG=1 ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$$REPEAT^XLFSTR(" ",REPEAT)_SEG
.. S FLG=1,GMRCCT=GMRCCT+1
.. S GMRCD=$E(GMRCD,$L(SEG)+1,999)
. I $F(GMRCD," ")'=2 S REPEAT=23
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$$REPEAT^XLFSTR(" ",REPEAT)_GMRCD
. S GMRCCT=GMRCCT+1,GMRCD=""
I $G(GMRCD)'="" D
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Provisional Diagnosis: "_GMRCD
. S GMRCCT=GMRCCT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSLM2 11671 printed Sep 23, 2025@19:23:13 Page 2
GMRCSLM2 ;SLC/DCM,WAT - LM Detailed display and printing ;Sep 10, 2020@14:20:28
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,18,15,17,23,22,65,66,73,81,110,145**;DEC 27,1997;Build 18
+2 ;
+3 ;ICRs
+4 ;GLOBALS/FILES
+5 ;#872 ^ORD(101 #875 ORDER STATUS file point(100.01) #2638 ORDER STATUS file access #2849 ORDERS file #10060 NEW PERSON (file 200) #10040 HOSPITAL LOCATION (^SC)
+6 ;#10090 INSTITUTION
+7 ;ROUTINES
+8 ;#2467 $$OI^ORX8 #2056 $$GET1^DIQ #10104 XLFSTR #4156 $$CVEDT^DGCV #10117 ^VALM10 #4807 RDIS^DGRPDB
+9 ;
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,GMRCUCID
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 ;110
SET GMRCUCID=$$GET1^DIQ(123,+GMRCO,80)
IF GMRCUCID]""
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="UCID:"_$EXTRACT(TAB,1,23-$LENGTH("UCID:"))_GMRCUCID
SET GMRCCT=GMRCCT+1
+20 DO ELIG^VADPT
+21 if $LENGTH($PIECE(VAEL(1),"^",2))
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Primary Eligibility:"_$EXTRACT(TAB,1,3)_$PIECE(VAEL(1),"^",2)_$SELECT(VAEL(8)']"":" (NOT VERIFIED)",1:"("_$PIECE(VAEL(8),"^",2)_")")
SET GMRCCT=GMRCCT+1
+22 ;wat 66
+23 IF $LENGTH($PIECE(VAEL(6),U,2))
Begin DoDot:1
+24 ;if TYPE is Active Duty and VETERAN Y/N? is No, then call the pt Active Duty
+25 IF $PIECE(VAEL(6),U,1)=5&(VAEL(4)=0)
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Patient Type:"_$EXTRACT(TAB,1,10)_$PIECE(VAEL(6),U,2)
SET GMRCCT=GMRCCT+1
+26 IF '$TEST
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Patient Type:"_$EXTRACT(TAB,1,10)_$PIECE(VAEL(6),U,2)
SET GMRCCT=GMRCCT+1
End DoDot:1
+27 ;//wat 66
+28 ;WAT
SET CVELIG=$$CVEDT^DGCV(DFN)
if $PIECE($GET(CVELIG),U,3)
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="CV Eligible:"_$EXTRACT(TAB,1,11)_"YES"
SET GMRCCT=GMRCCT+1
+29 ;wat 66
+30 NEW VASV,OIFOEF
SET OIFOEF="NO"
DO SVC^VADPT
if (VASV(11)>0)!(VASV(12)>0)!(VASV(13)>0)
SET OIFOEF="YES"
+31 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="OEF/OIF: "_$EXTRACT(TAB,1,14)_$GET(OIFOEF)
SET GMRCCT=GMRCCT+1
+32 ; GET SC RATINGS AND %
+33 NEW INC,COND
SET INC=0
+34 IF $PIECE(VAEL(3),U)=1
Begin DoDot:1
+35 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+36 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Service Connection/Rated Disabilities"
SET GMRCCT=GMRCCT+1
+37 IF '$PIECE(VAEL(3),U,2)
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="SC Percent:"_$EXTRACT(TAB,1,12)_"DATA NOT FOUND"
SET GMRCCT=GMRCCT+1
+38 IF '$TEST
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="SC Percent:"_$EXTRACT(TAB,1,12)_$PIECE(VAEL(3),U,2)_"%"
SET GMRCCT=GMRCCT+1
+39 DO RDIS^DGRPDB(DFN,.GMRCRDIS)
IF $DATA(GMRCRDIS(1))
Begin DoDot:2
+40 FOR
SET INC=$ORDER(GMRCRDIS(INC))
if INC=""
QUIT
Begin DoDot:3
+41 SET COND=$$GET1^DIQ(31,$PIECE(GMRCRDIS(INC),U),.01)
+42 if $GET(INC)=1
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Rated Disabilities:"_$EXTRACT(TAB,1,4)_$GET(COND)_" ("_$PIECE(GMRCRDIS(INC),U,2)_"%)"
SET GMRCCT=GMRCCT+1
+43 if $GET(INC)>1
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=$EXTRACT(TAB,1,23)_$GET(COND)_" ("_$PIECE(GMRCRDIS(INC),U,2)_"%)"
SET GMRCCT=GMRCCT+1
End DoDot:3
End DoDot:2
+44 IF '$DATA(GMRCRDIS)
Begin DoDot:2
+45 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Rated Disabilities:"_$EXTRACT(TAB,1,4)_"NONE STATED"
SET GMRCCT=GMRCCT+1
End DoDot:2
End DoDot:1
+46 ;//wat 66
+47 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+48 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Order Information"
SET GMRCCT=GMRCCT+1
+49 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
+50 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
+51 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
+52 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
+53 IF $LENGTH($PIECE(GMRCO(0),"^",18))
Begin DoDot:1
+54 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
+55 QUIT
End DoDot:1
+56 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
+57 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
+58 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Clinically Ind. Date:"_$EXTRACT(TAB,1,2)_$$FMTE^XLFDT($PIECE($GET(GMRCO(0)),"^",24),1)
SET GMRCCT=GMRCCT+1
+59 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="DST ID:"_$EXTRACT(TAB,1,16)_$GET(^GMR(123,+GMRCO,75))
SET GMRCCT=GMRCCT+1
+60 SET X="ORX8"
XECUTE ^%ZOSF("TEST")
IF $TEST
Begin DoDot:1
+61 NEW GMRCOITM
SET GMRCOITM=$$OI^ORX8(ORIFN)
+62 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Orderable Item:"_$EXTRACT(TAB,1,8)_$PIECE(GMRCOITM,U,2)
SET GMRCCT=GMRCCT+1
+63 QUIT
End DoDot:1
+64 SET GMRCPRNM=$PIECE(GMRCO(0),"^",8)
SET GMRCPROC=$SELECT(+GMRCPRNM:$PIECE($GET(^GMR(123.3,+GMRCPRNM,0)),"^"),1:"Consult Request")
+65 IF $LENGTH(GMRCPROC)
Begin DoDot:1
+66 NEW GMRCLN
+67 SET GMRCTYPE=$SELECT($PIECE(GMRCO(0),U,17)="P":"Procedure",1:"Consult")
+68 SET GMRCLN=GMRCTYPE_":"_$EXTRACT(TAB,1,22-$LENGTH(GMRCTYPE))_GMRCPROC
+69 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=GMRCLN
+70 SET GMRCCT=GMRCCT+1
+71 IF $GET(^GMR(123,+GMRCO,1))
Begin DoDot:2
+72 SET GMRCLN=""
+73 SET GMRCLN="Clinical Procedure:"_$EXTRACT(TAB,1,4)
+74 SET GMRCLN=GMRCLN_$$GET1^DIQ(123,+GMRCO,1.01,"E")
+75 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=GMRCLN
+76 SET GMRCCT=GMRCCT+1
End DoDot:2
+77 QUIT
End DoDot:1
+78 DO PROVDIAG(+GMRCO)
+79 IF $DATA(^GMR(123,+GMRCO,20,0))
Begin DoDot:1
+80 IF $ORDER(^GMR(123,+GMRCO,20,0))
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Reason For Request:"
SET GMRCCT=GMRCCT+1
Begin DoDot:2
+81 SET LN=0
+82 FOR
SET LN=$ORDER(^GMR(123,+GMRCO,20,LN))
if LN=""
QUIT
Begin DoDot:3
+83 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=^GMR(123,+GMRCO,20,LN,0)
+84 IF $GET(GMRCIERR)
Begin DoDot:4
+85 NEW TXT
SET TXT=^TMP("GMRCR",$JOB,"DT",GMRCCT,0)_"..."
+86 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=TXT
+87 ;quit with just one line
SET LN=9999
End DoDot:4
+88 SET GMRCCT=GMRCCT+1
End DoDot:3
+89 QUIT
End DoDot:2
QUIT
+90 QUIT
End DoDot:1
+91 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=" "
SET GMRCCT=GMRCCT+1
+92 ; get inter-facility consult info
+93 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Inter-facility Information"
SET GMRCCT=GMRCCT+1
+94 IF '$PIECE(GMRCO(0),"^",23)
Begin DoDot:1
+95 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="This is not an inter-facility consult request."
SET GMRCCT=GMRCCT+1
End DoDot:1
+96 IF '$TEST
Begin DoDot:1
+97 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=$$REPEAT^XLFSTR("-",27)
+98 SET GMRCCT=GMRCCT+1
+99 NEW GMRCOP
+100 ;WAT/73
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Remote Facility:"_$EXTRACT(TAB,1,6)_$$GET1^DIQ(4,+$PIECE(GMRCO(0),"^",23),.01)
SET GMRCCT=GMRCCT+1
+101 SET GMRCO(12)=$GET(^GMR(123,+GMRCO,12))
+102 IF $LENGTH($PIECE(GMRCO(12),U,6))
Begin DoDot:2
+103 SET GMRCOP=$PIECE(GMRCO(12),U,6)
End DoDot:2
+104 IF '$DATA(GMRCOP)
SET GMRCOP=$$GET1^DIQ(200,+$PIECE(GMRCO(0),U,14),.01)
+105 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Ordering Provider:"_$EXTRACT(TAB,1,5)_GMRCOP
SET GMRCCT=GMRCCT+1
+106 SET GMRCO(13)=$GET(^GMR(123,+GMRCO,13))
IF $LENGTH($PIECE(GMRCO(13),U,2,3))>1
Begin DoDot:2
+107 NEW LINE
+108 SET LINE=$PIECE(GMRCO(13),U,2)
IF $LENGTH(LINE)
SET LINE=LINE_$EXTRACT(TAB,1,5)
Begin DoDot:3
+109 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Ordering Provider phone: "_LINE
+110 SET GMRCCT=GMRCCT+1
End DoDot:3
+111 SET LINE=$PIECE(GMRCO(13),U,3)
IF $LENGTH(LINE)
SET LINE=LINE_$EXTRACT(TAB,1,5)
Begin DoDot:3
+112 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Ordering Provider pager: "_LINE
+113 SET GMRCCT=GMRCCT+1
End DoDot:3
End DoDot:2
+114 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Remote Consult #"_$EXTRACT(TAB)_$PIECE(GMRCO(0),"^",22)
SET GMRCCT=GMRCCT+1
+115 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
+116 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
+117 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+118 ;get status, last action, and significant findings
+119 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
+120 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
+121 IF $LENGTH($PIECE(GMRCO(0),"^",19))
Begin DoDot:1
+122 SET GMRCSF=$PIECE(GMRCO(0),"^",19)
+123 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Significant Findings: "_$SELECT(GMRCSF="Y":"YES",GMRCSF="N":"NO",1:"Unknown")
+124 SET GMRCCT=GMRCCT+1
+125 QUIT
End DoDot:1
+126 ;don't need results or activities on IFC errors
IF $GET(GMRCIERR)
QUIT
+127 DO ACTLOG^GMRCSLM4(+GMRCO)
+128 ; any inter-facility results?
+129 IF $PIECE(GMRCO(0),"^",23)
Begin DoDot:1
+130 NEW GMRCIFRS,X
SET GMRCIFRS=0
SET X=""
+131 FOR
SET X=$ORDER(^GMR(123,GMRCO,51,"B",X))
if X=""
QUIT
SET GMRCIFRS=GMRCIFRS+1
+132 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+133 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
+134 ;get local results
+135 DO GETRSLT^GMRCART($NAME(^TMP("GMRCRT",$JOB)),1)
+136 NEW NXT
SET NXT=0
+137 FOR
SET NXT=$ORDER(^TMP("GMRCRT",$JOB,NXT))
if 'NXT
QUIT
Begin DoDot:1
+138 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=$GET(^TMP("GMRCRT",$JOB,NXT,0))
+139 SET GMRCCT=GMRCCT+1
+140 QUIT
End DoDot:1
+141 KILL ^TMP("GMRCRT",$JOB)
+142 IF $SELECT('$DATA(GMRCOER):1,'GMRCOER:1,1:0)
IF $DATA(VALMAR)
DO CLEAN^VALM10
+143 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,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
PROVDIAG(GMRCDA) ;test all prov diags
+1 NEW GMRCD,GMRCCODE,PIECE,FLG,CODINTXT,BUFFER,REPEAT
+2 SET FLG=0
+3 ;spaces to repeat for formatting
SET REPEAT=22
+4 SET GMRCD=$GET(^GMR(123,GMRCDA,30))
+5 SET GMRCCODE=$GET(^GMR(123,GMRCDA,30.1))
SET CODINTXT="("_$PIECE(GMRCCODE,U)_")"
+6 ;icd-9 consults stored code in diagnosis text, icd-10 does not. Strip code from text and append to end for display
+7 ;desired coding system and code display format (ICD-9-CM 123.45) or (ICD-10-CM S06.4X0S)
+8 IF GMRCD[$GET(CODINTXT)
Begin DoDot:1
+9 SET GMRCD=$EXTRACT(GMRCD,0,($LENGTH(GMRCD)-$LENGTH(CODINTXT)))
End DoDot:1
+10 IF $LENGTH($PIECE(GMRCCODE,U))>0
Begin DoDot:1
+11 IF $PIECE(GMRCCODE,U,3)="ICD"
SET GMRCD=GMRCD_"(ICD-9-CM "_$PIECE(GMRCCODE,U)_")"
+12 IF $PIECE(GMRCCODE,U,3)="10D"
SET GMRCD=GMRCD_"(ICD-10-CM "_$PIECE(GMRCCODE,U)_")"
End DoDot:1
+13 IF $LENGTH($GET(GMRCD))>54
Begin DoDot:1
+14 ;$L of GMRCD will change below, so hold original length in PIECE
FOR
SET PIECE=$LENGTH(GMRCD)
if PIECE<54
QUIT
Begin DoDot:2
+15 NEW SEG,I
SET I=2
+16 FOR
SET SEG=$PIECE(GMRCD," ",1,I)
if $LENGTH(SEG)>=54!($LENGTH(SEG," ")<I)
QUIT
SET I=I+1
+17 ;means GMRCD doesn't contain spaces, e.g. v55,250.00,414.00,etc.
IF $LENGTH(SEG)=$LENGTH(GMRCD)
SET SEG=$EXTRACT(GMRCD,1,54)
+18 SET BUFFER=SEG
+19 ;$P only good when SEG contains a space, otherwise grab a SEG from BUFFER
if SEG[" "
SET SEG=$PIECE(GMRCD," ",1,(I-1))
IF $LENGTH(SEG)=0
SET SEG=$EXTRACT(BUFFER,1,54)
+20 if FLG=0
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Provisional Diagnosis: "_SEG
+21 IF FLG=1&($FIND(GMRCD," ")'=2)
SET REPEAT=23
+22 if FLG=1
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=$$REPEAT^XLFSTR(" ",REPEAT)_SEG
+23 SET FLG=1
SET GMRCCT=GMRCCT+1
+24 SET GMRCD=$EXTRACT(GMRCD,$LENGTH(SEG)+1,999)
End DoDot:2
+25 IF $FIND(GMRCD," ")'=2
SET REPEAT=23
+26 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=$$REPEAT^XLFSTR(" ",REPEAT)_GMRCD
+27 SET GMRCCT=GMRCCT+1
SET GMRCD=""
End DoDot:1
+28 IF $GET(GMRCD)'=""
Begin DoDot:1
+29 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Provisional Diagnosis: "_GMRCD
+30 SET GMRCCT=GMRCCT+1
End DoDot:1
+31 QUIT
