GMRCART ;SLC/DCM,DLT,JFR - Result display logic ;12/17/01 22:39
;;3.0;CONSULT/REQUEST TRACKING;**4,15,17,23,22,38,154,171**;DEC 27, 1997;Build 3
;
; This routine invokes IA #2638,#10060
;
RT(GMRCO) ;Result Display logic - called from GMRCA1
N GMRCCT,GMRCTMP,GMRCSR,GMRCTUFN,GMRCSTS,GMRCMSG
;
S GMRCSR=$P($G(^GMR(123,+GMRCO,0)),"^",15),GMRCTUFN=$P(^(0),"^",20)
S GMRCSTS=$P($G(^GMR(123,+GMRCO,0)),"^",12)
I '$$RESOLUS^GMRCAU(GMRCSTS),('+GMRCSR&('GMRCTUFN)) S GMRCMSG="No results available for review." D EXAC^GMRCADC(GMRCMSG),END S GMRCQUT=1 Q
;
W !,"Compiling Result Display..."
I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
K ^TMP("GMRCR",$J,"DT") S GMRCCT=1
S XQORM("A")="Select Action: "
S:$D(VALMAR) GMRCVAL=VALMAR
S GMRCTMP="^TMP(""GMRCR"",$J,""DT"")"
S GMRCDVL="",$P(GMRCDVL,"-",41)=""
;
D GETRSLT(GMRCTMP)
;
D EN^VALM("GMRC RESULTS DISPLAY")
S:$D(GMRCVAL) VALMAR=GMRCVAL S:$D(LNCT) VALMCNT=LNCT
D KILL^VALM10()
K OREND,ORAGE,ORIO,ORDOB,ORFT,ORHI,ORIFN,ORNP,ORL,ORPD,ORPNM,ORPV,ORSEQ,ORSEX,ORWARD,ORDG
K GMRCDVL,GMRCLCT,GMRCRPT,GMRCTUFN,GMRCVAL,MCFILE,MCPROC,GMRCX,GMRCTO,GMRCPRNM
D END
Q
;
GETRSLT(TMPGLOB,GMRCDET) ;load the results into global defined in TMPGLOB
;used for GUI formated results and list manager
;
;I GMRCDET=1 coming from a detailed display not results display
;
N GMRCCT,GMRCCTS,SF,TAB
S TAB="",$P(TAB," ",31)=""
S GMRCDVL="",$P(GMRCDVL,"-",41)=""
K @TMPGLOB,^TMP("GMRCR",$J,"CP")
S GMRCCT=1
S:'$D(GMRCDET) GMRCDET=0
I $L($P(^GMR(123,GMRCO,0),"^",19)) S SF=$P(^(0),"^",19),@TMPGLOB@(GMRCCT,0)="Significant Findings: "_$S(SF="Y":"**Yes**",SF="N":"No",1:"Unknown"),GMRCCT=GMRCCT+1
;S @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL,GMRCCT=GMRCCT+1 ;GMRCDVL_GMRCDVL
D PRINT^GMRCTIUP(GMRCO,GMRCCT,1,GMRCDET)
S GMRCCTS=GMRCCT ;save the line count before printing med and TIU notes
D GETMCAR
D GETCP
D GETRES
; I '$D(GMRCDET) D GETREMOT(GMRCO,TMPGLOB,.GMRCCT)
I GMRCCT=GMRCCTS D ;check if count changed for notes or med results
. S:+$L($G(SF)) @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL,GMRCCT=GMRCCT+1 ;GMRCDVL_GMRCDVL
. S @TMPGLOB@(GMRCCT,0)="No local TIU results or Medicine results available for this consult"
. S GMRCCT=GMRCCT+1
;
I '$D(GMRCDET) D GETCOM
I GMRCCT>2 S @TMPGLOB@(GMRCCT,0)="",$P(@TMPGLOB@(GMRCCT,0),"=",81)="",GMRCCT=GMRCCT+1
Q
;
GETMCAR ;load the medicine results into TMPGLOB
Q:'$O(^TMP("GMRCR",$J,"MCAR",0))
N ND,ND1
S ND=0 F S ND=$O(^TMP("GMRCR",$J,"MCAR",ND)) Q:ND=""!(ND?1A.E) D
.S @TMPGLOB@(GMRCCT,0)="",$P(^(0),"-",80)="",GMRCCT=GMRCCT+1
.S @TMPGLOB@(GMRCCT,0)=TAB_"Medicine Package Report",GMRCCT=GMRCCT+1
.S ND1=0 F S ND1=$O(^TMP("GMRCR",$J,"MCAR",ND,ND1)) Q:ND1="" S @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$J,"MCAR",ND,ND1,0),GMRCCT=GMRCCT+1
.Q
K ^TMP("GMRCR",$J,"MCAR")
Q
;
GETCP ; Load up any Clin. Proc. results
Q:'$O(^TMP("GMRCR",$J,"CP",0))
N ND,ND1
S ND=0 F S ND=$O(^TMP("GMRCR",$J,"CP",ND)) Q:ND=""!(ND?1A.E) D
.S @TMPGLOB@(GMRCCT,0)="",$P(^(0),"-",80)="",GMRCCT=GMRCCT+1
.S @TMPGLOB@(GMRCCT,0)=TAB_"Clinical Procedure Report",GMRCCT=GMRCCT+1
.S ND1=0 F S ND1=$O(^TMP("GMRCR",$J,"CP",ND,ND1)) Q:ND1="" D
.. S @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$J,"CP",ND,ND1,0),GMRCCT=GMRCCT+1
.Q
K ^TMP("GMRCR",$J,"CP")
Q
;
GETRES ;load the TIU notes into TMPGLOB
Q:'+$O(^TMP("GMRCR",$J,"RES",0))
;
N ND,ND1
S ND=0 F S ND=$O(^TMP("GMRCR",$J,"RES",ND)) Q:(ND="")!(ND?1A.E) D
. I $D(^TMP("GMRCR",$J,"RES",ND,"TEXT","GMRCRPT")) D
. . S @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
. . S @TMPGLOB@(GMRCCT,0)=$E(GMRCDVL,1,80-$L(^TMP("GMRCR",$J,"RES",ND,"TEXT","GMRCRPT"))\2)_^("GMRCRPT")_$E(GMRCDVL,1,80-$L(^("GMRCRPT"))\2)
. . S GMRCCT=GMRCCT+1
. S:'$D(^TMP("GMRCR",$J,"RES",ND,"TEXT","GMRCRPT")) @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL,GMRCCT=GMRCCT+1
. S:$O(^TMP("GMRCR",$J,"RES",ND,"TEXT",0)) @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
. S ND1=0 F S ND1=$O(^TMP("GMRCR",$J,"RES",ND,"TEXT",ND1)) Q:ND1?1A.E!(ND1="") S @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$J,"RES",ND,"TEXT",ND1,0),GMRCCT=GMRCCT+1
. I $O(^TMP("GMRCR",$J,"RES",ND,"ADD",0)) S ND1=0 F S ND1=$O(^TMP("GMRCR",$J,"RES",ND,"ADD",ND1)) Q:ND1="" D
. . S @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
. . S @TMPGLOB@(GMRCCT,0)=TAB_"ADDENDUM TO REPORT",GMRCCT=GMRCCT+1
. . S ND2=0 F S ND2=$O(^TMP("GMRCR",$J,"RES",ND,"ADD",ND1,ND2)) Q:ND2=""!(ND2?1A.E) S @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$J,"RES",ND,"ADD",ND1,ND2,0),GMRCCT=GMRCCT+1
. . Q
. Q
K ^TMP("GMRCR",$J,"RES")
Q
;
GETCOM ;Get the comments for resolution actions
S GMRCSTS=$P($G(^GMR(123,+GMRCO,0)),"^",12)
Q:'$$RESOLUS^GMRCAU(+GMRCSTS)
;
;Loop thru actions to find the resolution type actions
N ND,ND1,ND2
S ND="" F S ND=$O(^GMR(123,+GMRCO,40,"B",ND)) Q:ND="" S ND1=$O(^GMR(123,+GMRCO,40,"B",ND,"")) D
. ;
. ;Check for resulting action types:complete,sig finding,dc,cancel
. N GMRCAIEN
. S GMRCAIEN=$P($G(^GMR(123,+GMRCO,40,ND1,0)),"^",2)
. I '$$RESOLUA^GMRCAU(GMRCAIEN) Q
. ;
. ;save the action header info in case there are comments
. N GMRCAHDR,GMRCPROV,GMRCENBY,GMRCENDT
. D SAVEHDR
. ;
. ;check for comments, print header on first pass
. S ND2=0
. F S ND2=$O(^GMR(123,GMRCO,40,ND1,1,ND2)) Q:ND2="" D
. . I +$G(GMRCAHDR) D GETHDR ;GMRCAHDR will =1 on first pass
. . S @TMPGLOB@(GMRCCT,0)=^GMR(123,GMRCO,40,ND1,1,ND2,0),GMRCCT=GMRCCT+1
. . Q
. Q
Q
;
SAVEHDR ;Save the action header info to print later if there are comments
S GMRCAHDR=1 ;flag to print action header on first pass of comments
;save the provider, entered by and date
S GMRCPROV=$P(^GMR(123,GMRCO,40,ND1,0),"^",4),GMRCENBY=$P(^(0),"^",5)
S GMRCENDT=$$FMTE^XLFDT($P($G(^GMR(123,GMRCO,40,ND1,0)),"^",3))
Q
;
GETHDR ;Print the comment header if the action had a comment
S @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
S @TMPGLOB@(GMRCCT,0)=$$CENTER^GMRCP5D("("_$P($G(^GMR(123.1,GMRCAIEN,0)),"^",8)_" Comment)"),GMRCCT=GMRCCT+1
S @TMPGLOB@(GMRCCT,0)=" Entered by: "_$S($L(GMRCENBY):$P(^VA(200,GMRCENBY,0),"^",1),1:"")_" - "_GMRCENDT,GMRCCT=GMRCCT+1
I +GMRCPROV S @TMPGLOB@(GMRCCT,0)=" Responsible Clinician: "_$P($G(^VA(200,GMRCPROV,0)),"^",1),GMRCCT=GMRCCT+1
K GMRCAHDR
Q
;
GETREMOT(GMRCDA,GMRCAR,GMRCNT) ;retrieve remote results and load up in display
; Input:
; GMRCDA = consult ien from file 123
; GMRCAR = array to return results in (e.g. $NA(^TMP("GMRCAR",$J)) )
; GMRCNT = number within GMRCAR to start placing results (pass by ref)
;
;Output:
; array containing remote results in format:
; ^TMP("GMRCAR",$J,1,0)= result text line 1
; ^TMP("GMRCAR",$J,2,0)= result text line 2
;
I '$O(^GMR(123,GMRCDA,51,0)) Q ;no remote results
N HDR,GMRCREM,GMRCDATA,FTR,GMRCIO
S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
S HDR=$$REPEAT^XLFSTR("*",31)_" REMOTE RESULTS "_$$REPEAT^XLFSTR("*",31)
S FTR=$$REPEAT^XLFSTR("*",27)_" END OF REMOTE RESULTS "_$$REPEAT^XLFSTR("*",28)
S @GMRCAR@(GMRCNT,0)=HDR,GMRCNT=GMRCNT+1
S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
S GMRCREM=0 F S GMRCREM=$O(^GMR(123,GMRCDA,51,GMRCREM)) Q:'GMRCREM D
. N GMRCSITE,GMRCRES,GMRCSTA,GMRCRPC,GMRCREM0
. S GMRCREM0=^GMR(123,GMRCDA,51,GMRCREM,0) Q:'$L(GMRCREM0)
. S GMRCSTA=$$STA^XUAF4($P(GMRCREM0,U,3))
. D F4^XUAF4(GMRCSTA,.GMRCSITE) I '+GMRCSITE Q
. ;BL; Need to check if site has been converted to Cerner and if so route properly
. ; S:$$CNVTD^GMRCIEVT(+GMRCSITE) GMRCSTA="200CRNR"
. S:$$CNVTD^GMRCIEVT(GMRCDA) GMRCSTA="200CRNR"
. ;
. S GMRCRES=$P(GMRCREM0,U,2)_","
. I GMRCRES["TIU" S GMRCRPC="TIU GET RECORD TEXT",GMRCRES=+GMRCRES
. ;BL;If this is a converted site add the the ICN to the string
. N DFN,ICN ;MKN 171 changed K DFN,ICN to N DFN,ICN
. I GMRCSTA["200CRNR" D
. . S DFN=$P(^GMR(123,GMRCDA,0),"^",2)
. . S ICN=$$GETICN^MPIF001(DFN)
. . S GMRCRES=ICN_"\"_GMRCRES
. ;
. I GMRCRES["MCAR" S GMRCRPC="ORQQCN GET MED RESULT DETAILS"
. D SAVDEV^%ZISUTL("GMRCIO") ; save off current device settings
. D DIRECT^XWB2HL7(.GMRCDATA,GMRCSTA,GMRCRPC,"0",GMRCRES)
. D USE^%ZISUTL("GMRCIO") ; restore IO to previous settings
. D RMDEV^%ZISUTL("GMRCIO") ; kills data saved in GMRCIO
. I '$D(GMRCDATA) Q
. S @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR($S(GMRCRES["MCAR":"Medicine report from:",1:"TIU Document from:"),80),GMRCNT=GMRCNT+1
. S @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR(GMRCSITE("NAME"),80)
. S GMRCNT=GMRCNT+1
. S @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR("Associated on: "_$$FMTE^XLFDT(+GMRCREM0),80),GMRCNT=GMRCNT+1
. S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
. N GMRCQT S GMRCQT=0
. I '$L($G(GMRCDATA)) D
.. N I S I="" F S I=$O(GMRCDATA(I)) Q:I=""!(GMRCQT) D
... I $P(GMRCDATA(I),U)=-1 D S GMRCQT=1 Q
.... S @GMRCAR@(GMRCNT,0)="Report not currently available"
.... S GMRCNT=GMRCNT+1
... S @GMRCAR@(GMRCNT,0)=GMRCDATA(I),GMRCNT=GMRCNT+1
. I $L($G(GMRCDATA)),$D(@GMRCDATA) D
.. N I S I="" F S I=$O(@GMRCDATA@(I)) Q:I=""!(GMRCQT) D
... I $P(@GMRCDATA@(I),U)=-1 D S GMRCQT=1 Q
.... S @GMRCAR@(GMRCNT,0)="Report not currently available"
.... S GMRCNT=GMRCNT+1
... S @GMRCAR@(GMRCNT,0)=@GMRCDATA@(I),GMRCNT=GMRCNT+1
.. K @GMRCDATA
. K GMRCDATA
. Q
S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
S @GMRCAR@(GMRCNT,0)=FTR,GMRCNT=GMRCNT+1
S @GMRCAR@(GMRCNT,0)=""
Q
;
END ;kill off variables and exit
I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
K DTOUT,DIROUT,DUOUT
S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCART 9470 printed Apr 09, 2024@20:51:57 Page 2
GMRCART ;SLC/DCM,DLT,JFR - Result display logic ;12/17/01 22:39
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4,15,17,23,22,38,154,171**;DEC 27, 1997;Build 3
+2 ;
+3 ; This routine invokes IA #2638,#10060
+4 ;
RT(GMRCO) ;Result Display logic - called from GMRCA1
+1 NEW GMRCCT,GMRCTMP,GMRCSR,GMRCTUFN,GMRCSTS,GMRCMSG
+2 ;
+3 SET GMRCSR=$PIECE($GET(^GMR(123,+GMRCO,0)),"^",15)
SET GMRCTUFN=$PIECE(^(0),"^",20)
+4 SET GMRCSTS=$PIECE($GET(^GMR(123,+GMRCO,0)),"^",12)
+5 IF '$$RESOLUS^GMRCAU(GMRCSTS)
IF ('+GMRCSR&('GMRCTUFN))
SET GMRCMSG="No results available for review."
DO EXAC^GMRCADC(GMRCMSG)
DO END
SET GMRCQUT=1
QUIT
+6 ;
+7 WRITE !,"Compiling Result Display..."
+8 IF $DATA(IOTM)
IF $DATA(IOBM)
IF $DATA(IOSTBM)
DO FULL^VALM1
+9 KILL ^TMP("GMRCR",$JOB,"DT")
SET GMRCCT=1
+10 SET XQORM("A")="Select Action: "
+11 if $DATA(VALMAR)
SET GMRCVAL=VALMAR
+12 SET GMRCTMP="^TMP(""GMRCR"",$J,""DT"")"
+13 SET GMRCDVL=""
SET $PIECE(GMRCDVL,"-",41)=""
+14 ;
+15 DO GETRSLT(GMRCTMP)
+16 ;
+17 DO EN^VALM("GMRC RESULTS DISPLAY")
+18 if $DATA(GMRCVAL)
SET VALMAR=GMRCVAL
if $DATA(LNCT)
SET VALMCNT=LNCT
+19 DO KILL^VALM10()
+20 KILL OREND,ORAGE,ORIO,ORDOB,ORFT,ORHI,ORIFN,ORNP,ORL,ORPD,ORPNM,ORPV,ORSEQ,ORSEX,ORWARD,ORDG
+21 KILL GMRCDVL,GMRCLCT,GMRCRPT,GMRCTUFN,GMRCVAL,MCFILE,MCPROC,GMRCX,GMRCTO,GMRCPRNM
+22 DO END
+23 QUIT
+24 ;
GETRSLT(TMPGLOB,GMRCDET) ;load the results into global defined in TMPGLOB
+1 ;used for GUI formated results and list manager
+2 ;
+3 ;I GMRCDET=1 coming from a detailed display not results display
+4 ;
+5 NEW GMRCCT,GMRCCTS,SF,TAB
+6 SET TAB=""
SET $PIECE(TAB," ",31)=""
+7 SET GMRCDVL=""
SET $PIECE(GMRCDVL,"-",41)=""
+8 KILL @TMPGLOB,^TMP("GMRCR",$JOB,"CP")
+9 SET GMRCCT=1
+10 if '$DATA(GMRCDET)
SET GMRCDET=0
+11 IF $LENGTH($PIECE(^GMR(123,GMRCO,0),"^",19))
SET SF=$PIECE(^(0),"^",19)
SET @TMPGLOB@(GMRCCT,0)="Significant Findings: "_$SELECT(SF="Y":"**Yes**",SF="N":"No",1:"Unknown")
SET GMRCCT=GMRCCT+1
+12 ;S @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL,GMRCCT=GMRCCT+1 ;GMRCDVL_GMRCDVL
+13 DO PRINT^GMRCTIUP(GMRCO,GMRCCT,1,GMRCDET)
+14 ;save the line count before printing med and TIU notes
SET GMRCCTS=GMRCCT
+15 DO GETMCAR
+16 DO GETCP
+17 DO GETRES
+18 ; I '$D(GMRCDET) D GETREMOT(GMRCO,TMPGLOB,.GMRCCT)
+19 ;check if count changed for notes or med results
IF GMRCCT=GMRCCTS
Begin DoDot:1
+20 ;GMRCDVL_GMRCDVL
if +$LENGTH($GET(SF))
SET @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL
SET GMRCCT=GMRCCT+1
+21 SET @TMPGLOB@(GMRCCT,0)="No local TIU results or Medicine results available for this consult"
+22 SET GMRCCT=GMRCCT+1
End DoDot:1
+23 ;
+24 IF '$DATA(GMRCDET)
DO GETCOM
+25 IF GMRCCT>2
SET @TMPGLOB@(GMRCCT,0)=""
SET $PIECE(@TMPGLOB@(GMRCCT,0),"=",81)=""
SET GMRCCT=GMRCCT+1
+26 QUIT
+27 ;
GETMCAR ;load the medicine results into TMPGLOB
+1 if '$ORDER(^TMP("GMRCR",$JOB,"MCAR",0))
QUIT
+2 NEW ND,ND1
+3 SET ND=0
FOR
SET ND=$ORDER(^TMP("GMRCR",$JOB,"MCAR",ND))
if ND=""!(ND?1A.E)
QUIT
Begin DoDot:1
+4 SET @TMPGLOB@(GMRCCT,0)=""
SET $PIECE(^(0),"-",80)=""
SET GMRCCT=GMRCCT+1
+5 SET @TMPGLOB@(GMRCCT,0)=TAB_"Medicine Package Report"
SET GMRCCT=GMRCCT+1
+6 SET ND1=0
FOR
SET ND1=$ORDER(^TMP("GMRCR",$JOB,"MCAR",ND,ND1))
if ND1=""
QUIT
SET @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$JOB,"MCAR",ND,ND1,0)
SET GMRCCT=GMRCCT+1
+7 QUIT
End DoDot:1
+8 KILL ^TMP("GMRCR",$JOB,"MCAR")
+9 QUIT
+10 ;
GETCP ; Load up any Clin. Proc. results
+1 if '$ORDER(^TMP("GMRCR",$JOB,"CP",0))
QUIT
+2 NEW ND,ND1
+3 SET ND=0
FOR
SET ND=$ORDER(^TMP("GMRCR",$JOB,"CP",ND))
if ND=""!(ND?1A.E)
QUIT
Begin DoDot:1
+4 SET @TMPGLOB@(GMRCCT,0)=""
SET $PIECE(^(0),"-",80)=""
SET GMRCCT=GMRCCT+1
+5 SET @TMPGLOB@(GMRCCT,0)=TAB_"Clinical Procedure Report"
SET GMRCCT=GMRCCT+1
+6 SET ND1=0
FOR
SET ND1=$ORDER(^TMP("GMRCR",$JOB,"CP",ND,ND1))
if ND1=""
QUIT
Begin DoDot:2
+7 SET @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$JOB,"CP",ND,ND1,0)
SET GMRCCT=GMRCCT+1
End DoDot:2
+8 QUIT
End DoDot:1
+9 KILL ^TMP("GMRCR",$JOB,"CP")
+10 QUIT
+11 ;
GETRES ;load the TIU notes into TMPGLOB
+1 if '+$ORDER(^TMP("GMRCR",$JOB,"RES",0))
QUIT
+2 ;
+3 NEW ND,ND1
+4 SET ND=0
FOR
SET ND=$ORDER(^TMP("GMRCR",$JOB,"RES",ND))
if (ND="")!(ND?1A.E)
QUIT
Begin DoDot:1
+5 IF $DATA(^TMP("GMRCR",$JOB,"RES",ND,"TEXT","GMRCRPT"))
Begin DoDot:2
+6 SET @TMPGLOB@(GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+7 SET @TMPGLOB@(GMRCCT,0)=$EXTRACT(GMRCDVL,1,80-$LENGTH(^TMP("GMRCR",$JOB,"RES",ND,"TEXT","GMRCRPT"))\2)_^("GMRCRPT")_$EXTRACT(GMRCDVL,1,80-$LENGTH(^("GMRCRPT"))\2)
+8 SET GMRCCT=GMRCCT+1
End DoDot:2
+9 if '$DATA(^TMP("GMRCR",$JOB,"RES",ND,"TEXT","GMRCRPT"))
SET @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL
SET GMRCCT=GMRCCT+1
+10 if $ORDER(^TMP("GMRCR",$JOB,"RES",ND,"TEXT",0))
SET @TMPGLOB@(GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+11 SET ND1=0
FOR
SET ND1=$ORDER(^TMP("GMRCR",$JOB,"RES",ND,"TEXT",ND1))
if ND1?1A.E!(ND1="")
QUIT
SET @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$JOB,"RES",ND,"TEXT",ND1,0)
SET GMRCCT=GMRCCT+1
+12 IF $ORDER(^TMP("GMRCR",$JOB,"RES",ND,"ADD",0))
SET ND1=0
FOR
SET ND1=$ORDER(^TMP("GMRCR",$JOB,"RES",ND,"ADD",ND1))
if ND1=""
QUIT
Begin DoDot:2
+13 SET @TMPGLOB@(GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+14 SET @TMPGLOB@(GMRCCT,0)=TAB_"ADDENDUM TO REPORT"
SET GMRCCT=GMRCCT+1
+15 SET ND2=0
FOR
SET ND2=$ORDER(^TMP("GMRCR",$JOB,"RES",ND,"ADD",ND1,ND2))
if ND2=""!(ND2?1A.E)
QUIT
SET @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$JOB,"RES",ND,"ADD",ND1,ND2,0)
SET GMRCCT=GMRCCT+1
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 KILL ^TMP("GMRCR",$JOB,"RES")
+19 QUIT
+20 ;
GETCOM ;Get the comments for resolution actions
+1 SET GMRCSTS=$PIECE($GET(^GMR(123,+GMRCO,0)),"^",12)
+2 if '$$RESOLUS^GMRCAU(+GMRCSTS)
QUIT
+3 ;
+4 ;Loop thru actions to find the resolution type actions
+5 NEW ND,ND1,ND2
+6 SET ND=""
FOR
SET ND=$ORDER(^GMR(123,+GMRCO,40,"B",ND))
if ND=""
QUIT
SET ND1=$ORDER(^GMR(123,+GMRCO,40,"B",ND,""))
Begin DoDot:1
+7 ;
+8 ;Check for resulting action types:complete,sig finding,dc,cancel
+9 NEW GMRCAIEN
+10 SET GMRCAIEN=$PIECE($GET(^GMR(123,+GMRCO,40,ND1,0)),"^",2)
+11 IF '$$RESOLUA^GMRCAU(GMRCAIEN)
QUIT
+12 ;
+13 ;save the action header info in case there are comments
+14 NEW GMRCAHDR,GMRCPROV,GMRCENBY,GMRCENDT
+15 DO SAVEHDR
+16 ;
+17 ;check for comments, print header on first pass
+18 SET ND2=0
+19 FOR
SET ND2=$ORDER(^GMR(123,GMRCO,40,ND1,1,ND2))
if ND2=""
QUIT
Begin DoDot:2
+20 ;GMRCAHDR will =1 on first pass
IF +$GET(GMRCAHDR)
DO GETHDR
+21 SET @TMPGLOB@(GMRCCT,0)=^GMR(123,GMRCO,40,ND1,1,ND2,0)
SET GMRCCT=GMRCCT+1
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 QUIT
+25 ;
SAVEHDR ;Save the action header info to print later if there are comments
+1 ;flag to print action header on first pass of comments
SET GMRCAHDR=1
+2 ;save the provider, entered by and date
+3 SET GMRCPROV=$PIECE(^GMR(123,GMRCO,40,ND1,0),"^",4)
SET GMRCENBY=$PIECE(^(0),"^",5)
+4 SET GMRCENDT=$$FMTE^XLFDT($PIECE($GET(^GMR(123,GMRCO,40,ND1,0)),"^",3))
+5 QUIT
+6 ;
GETHDR ;Print the comment header if the action had a comment
+1 SET @TMPGLOB@(GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+2 SET @TMPGLOB@(GMRCCT,0)=$$CENTER^GMRCP5D("("_$PIECE($GET(^GMR(123.1,GMRCAIEN,0)),"^",8)_" Comment)")
SET GMRCCT=GMRCCT+1
+3 SET @TMPGLOB@(GMRCCT,0)=" Entered by: "_$SELECT($LENGTH(GMRCENBY):$PIECE(^VA(200,GMRCENBY,0),"^",1),1:"")_" - "_GMRCENDT
SET GMRCCT=GMRCCT+1
+4 IF +GMRCPROV
SET @TMPGLOB@(GMRCCT,0)=" Responsible Clinician: "_$PIECE($GET(^VA(200,GMRCPROV,0)),"^",1)
SET GMRCCT=GMRCCT+1
+5 KILL GMRCAHDR
+6 QUIT
+7 ;
GETREMOT(GMRCDA,GMRCAR,GMRCNT) ;retrieve remote results and load up in display
+1 ; Input:
+2 ; GMRCDA = consult ien from file 123
+3 ; GMRCAR = array to return results in (e.g. $NA(^TMP("GMRCAR",$J)) )
+4 ; GMRCNT = number within GMRCAR to start placing results (pass by ref)
+5 ;
+6 ;Output:
+7 ; array containing remote results in format:
+8 ; ^TMP("GMRCAR",$J,1,0)= result text line 1
+9 ; ^TMP("GMRCAR",$J,2,0)= result text line 2
+10 ;
+11 ;no remote results
IF '$ORDER(^GMR(123,GMRCDA,51,0))
QUIT
+12 NEW HDR,GMRCREM,GMRCDATA,FTR,GMRCIO
+13 SET @GMRCAR@(GMRCNT,0)=""
SET GMRCNT=GMRCNT+1
+14 SET HDR=$$REPEAT^XLFSTR("*",31)_" REMOTE RESULTS "_$$REPEAT^XLFSTR("*",31)
+15 SET FTR=$$REPEAT^XLFSTR("*",27)_" END OF REMOTE RESULTS "_$$REPEAT^XLFSTR("*",28)
+16 SET @GMRCAR@(GMRCNT,0)=HDR
SET GMRCNT=GMRCNT+1
+17 SET @GMRCAR@(GMRCNT,0)=""
SET GMRCNT=GMRCNT+1
+18 SET GMRCREM=0
FOR
SET GMRCREM=$ORDER(^GMR(123,GMRCDA,51,GMRCREM))
if 'GMRCREM
QUIT
Begin DoDot:1
+19 NEW GMRCSITE,GMRCRES,GMRCSTA,GMRCRPC,GMRCREM0
+20 SET GMRCREM0=^GMR(123,GMRCDA,51,GMRCREM,0)
if '$LENGTH(GMRCREM0)
QUIT
+21 SET GMRCSTA=$$STA^XUAF4($PIECE(GMRCREM0,U,3))
+22 DO F4^XUAF4(GMRCSTA,.GMRCSITE)
IF '+GMRCSITE
QUIT
+23 ;BL; Need to check if site has been converted to Cerner and if so route properly
+24 ; S:$$CNVTD^GMRCIEVT(+GMRCSITE) GMRCSTA="200CRNR"
+25 if $$CNVTD^GMRCIEVT(GMRCDA)
SET GMRCSTA="200CRNR"
+26 ;
+27 SET GMRCRES=$PIECE(GMRCREM0,U,2)_","
+28 IF GMRCRES["TIU"
SET GMRCRPC="TIU GET RECORD TEXT"
SET GMRCRES=+GMRCRES
+29 ;BL;If this is a converted site add the the ICN to the string
+30 ;MKN 171 changed K DFN,ICN to N DFN,ICN
NEW DFN,ICN
+31 IF GMRCSTA["200CRNR"
Begin DoDot:2
+32 SET DFN=$PIECE(^GMR(123,GMRCDA,0),"^",2)
+33 SET ICN=$$GETICN^MPIF001(DFN)
+34 SET GMRCRES=ICN_"\"_GMRCRES
End DoDot:2
+35 ;
+36 IF GMRCRES["MCAR"
SET GMRCRPC="ORQQCN GET MED RESULT DETAILS"
+37 ; save off current device settings
DO SAVDEV^%ZISUTL("GMRCIO")
+38 DO DIRECT^XWB2HL7(.GMRCDATA,GMRCSTA,GMRCRPC,"0",GMRCRES)
+39 ; restore IO to previous settings
DO USE^%ZISUTL("GMRCIO")
+40 ; kills data saved in GMRCIO
DO RMDEV^%ZISUTL("GMRCIO")
+41 IF '$DATA(GMRCDATA)
QUIT
+42 SET @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR($SELECT(GMRCRES["MCAR":"Medicine report from:",1:"TIU Document from:"),80)
SET GMRCNT=GMRCNT+1
+43 SET @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR(GMRCSITE("NAME"),80)
+44 SET GMRCNT=GMRCNT+1
+45 SET @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR("Associated on: "_$$FMTE^XLFDT(+GMRCREM0),80)
SET GMRCNT=GMRCNT+1
+46 SET @GMRCAR@(GMRCNT,0)=""
SET GMRCNT=GMRCNT+1
+47 NEW GMRCQT
SET GMRCQT=0
+48 IF '$LENGTH($GET(GMRCDATA))
Begin DoDot:2
+49 NEW I
SET I=""
FOR
SET I=$ORDER(GMRCDATA(I))
if I=""!(GMRCQT)
QUIT
Begin DoDot:3
+50 IF $PIECE(GMRCDATA(I),U)=-1
Begin DoDot:4
+51 SET @GMRCAR@(GMRCNT,0)="Report not currently available"
+52 SET GMRCNT=GMRCNT+1
End DoDot:4
SET GMRCQT=1
QUIT
+53 SET @GMRCAR@(GMRCNT,0)=GMRCDATA(I)
SET GMRCNT=GMRCNT+1
End DoDot:3
End DoDot:2
+54 IF $LENGTH($GET(GMRCDATA))
IF $DATA(@GMRCDATA)
Begin DoDot:2
+55 NEW I
SET I=""
FOR
SET I=$ORDER(@GMRCDATA@(I))
if I=""!(GMRCQT)
QUIT
Begin DoDot:3
+56 IF $PIECE(@GMRCDATA@(I),U)=-1
Begin DoDot:4
+57 SET @GMRCAR@(GMRCNT,0)="Report not currently available"
+58 SET GMRCNT=GMRCNT+1
End DoDot:4
SET GMRCQT=1
QUIT
+59 SET @GMRCAR@(GMRCNT,0)=@GMRCDATA@(I)
SET GMRCNT=GMRCNT+1
End DoDot:3
+60 KILL @GMRCDATA
End DoDot:2
+61 KILL GMRCDATA
+62 QUIT
End DoDot:1
+63 SET @GMRCAR@(GMRCNT,0)=""
SET GMRCNT=GMRCNT+1
+64 SET @GMRCAR@(GMRCNT,0)=FTR
SET GMRCNT=GMRCNT+1
+65 SET @GMRCAR@(GMRCNT,0)=""
+66 QUIT
+67 ;
END ;kill off variables and exit
+1 IF $DATA(DTOUT)!$DATA(DIROUT)
SET GMRCQIT=""
+2 KILL DTOUT,DIROUT,DUOUT
+3 if $DATA(^TMP("GMRC",$JOB,"CURRENT","MENU"))
SET XQORM("HIJACK")=^("MENU")
+4 QUIT
