- 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 Feb 18, 2025@23:11:30 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