Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCART

GMRCART.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; This routine invokes IA #2638,#10060
  1. ;
  1. RT(GMRCO) ;Result Display logic - called from GMRCA1
  1. N GMRCCT,GMRCTMP,GMRCSR,GMRCTUFN,GMRCSTS,GMRCMSG
  1. ;
  1. S GMRCSR=$P($G(^GMR(123,+GMRCO,0)),"^",15),GMRCTUFN=$P(^(0),"^",20)
  1. S GMRCSTS=$P($G(^GMR(123,+GMRCO,0)),"^",12)
  1. I '$$RESOLUS^GMRCAU(GMRCSTS),('+GMRCSR&('GMRCTUFN)) S GMRCMSG="No results available for review." D EXAC^GMRCADC(GMRCMSG),END S GMRCQUT=1 Q
  1. ;
  1. W !,"Compiling Result Display..."
  1. I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
  1. K ^TMP("GMRCR",$J,"DT") S GMRCCT=1
  1. S XQORM("A")="Select Action: "
  1. S:$D(VALMAR) GMRCVAL=VALMAR
  1. S GMRCTMP="^TMP(""GMRCR"",$J,""DT"")"
  1. S GMRCDVL="",$P(GMRCDVL,"-",41)=""
  1. ;
  1. D GETRSLT(GMRCTMP)
  1. ;
  1. D EN^VALM("GMRC RESULTS DISPLAY")
  1. S:$D(GMRCVAL) VALMAR=GMRCVAL S:$D(LNCT) VALMCNT=LNCT
  1. D KILL^VALM10()
  1. K OREND,ORAGE,ORIO,ORDOB,ORFT,ORHI,ORIFN,ORNP,ORL,ORPD,ORPNM,ORPV,ORSEQ,ORSEX,ORWARD,ORDG
  1. K GMRCDVL,GMRCLCT,GMRCRPT,GMRCTUFN,GMRCVAL,MCFILE,MCPROC,GMRCX,GMRCTO,GMRCPRNM
  1. D END
  1. Q
  1. ;
  1. GETRSLT(TMPGLOB,GMRCDET) ;load the results into global defined in TMPGLOB
  1. ;used for GUI formated results and list manager
  1. ;
  1. ;I GMRCDET=1 coming from a detailed display not results display
  1. ;
  1. N GMRCCT,GMRCCTS,SF,TAB
  1. S TAB="",$P(TAB," ",31)=""
  1. S GMRCDVL="",$P(GMRCDVL,"-",41)=""
  1. K @TMPGLOB,^TMP("GMRCR",$J,"CP")
  1. S GMRCCT=1
  1. S:'$D(GMRCDET) GMRCDET=0
  1. 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
  1. ;S @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL,GMRCCT=GMRCCT+1 ;GMRCDVL_GMRCDVL
  1. D PRINT^GMRCTIUP(GMRCO,GMRCCT,1,GMRCDET)
  1. S GMRCCTS=GMRCCT ;save the line count before printing med and TIU notes
  1. D GETMCAR
  1. D GETCP
  1. D GETRES
  1. ; I '$D(GMRCDET) D GETREMOT(GMRCO,TMPGLOB,.GMRCCT)
  1. I GMRCCT=GMRCCTS D ;check if count changed for notes or med results
  1. . S:+$L($G(SF)) @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL,GMRCCT=GMRCCT+1 ;GMRCDVL_GMRCDVL
  1. . S @TMPGLOB@(GMRCCT,0)="No local TIU results or Medicine results available for this consult"
  1. . S GMRCCT=GMRCCT+1
  1. ;
  1. I '$D(GMRCDET) D GETCOM
  1. I GMRCCT>2 S @TMPGLOB@(GMRCCT,0)="",$P(@TMPGLOB@(GMRCCT,0),"=",81)="",GMRCCT=GMRCCT+1
  1. Q
  1. ;
  1. GETMCAR ;load the medicine results into TMPGLOB
  1. Q:'$O(^TMP("GMRCR",$J,"MCAR",0))
  1. N ND,ND1
  1. S ND=0 F S ND=$O(^TMP("GMRCR",$J,"MCAR",ND)) Q:ND=""!(ND?1A.E) D
  1. .S @TMPGLOB@(GMRCCT,0)="",$P(^(0),"-",80)="",GMRCCT=GMRCCT+1
  1. .S @TMPGLOB@(GMRCCT,0)=TAB_"Medicine Package Report",GMRCCT=GMRCCT+1
  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
  1. .Q
  1. K ^TMP("GMRCR",$J,"MCAR")
  1. Q
  1. ;
  1. GETCP ; Load up any Clin. Proc. results
  1. Q:'$O(^TMP("GMRCR",$J,"CP",0))
  1. N ND,ND1
  1. S ND=0 F S ND=$O(^TMP("GMRCR",$J,"CP",ND)) Q:ND=""!(ND?1A.E) D
  1. .S @TMPGLOB@(GMRCCT,0)="",$P(^(0),"-",80)="",GMRCCT=GMRCCT+1
  1. .S @TMPGLOB@(GMRCCT,0)=TAB_"Clinical Procedure Report",GMRCCT=GMRCCT+1
  1. .S ND1=0 F S ND1=$O(^TMP("GMRCR",$J,"CP",ND,ND1)) Q:ND1="" D
  1. .. S @TMPGLOB@(GMRCCT,0)=^TMP("GMRCR",$J,"CP",ND,ND1,0),GMRCCT=GMRCCT+1
  1. .Q
  1. K ^TMP("GMRCR",$J,"CP")
  1. Q
  1. ;
  1. GETRES ;load the TIU notes into TMPGLOB
  1. Q:'+$O(^TMP("GMRCR",$J,"RES",0))
  1. ;
  1. N ND,ND1
  1. S ND=0 F S ND=$O(^TMP("GMRCR",$J,"RES",ND)) Q:(ND="")!(ND?1A.E) D
  1. . I $D(^TMP("GMRCR",$J,"RES",ND,"TEXT","GMRCRPT")) D
  1. . . S @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
  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)
  1. . . S GMRCCT=GMRCCT+1
  1. . S:'$D(^TMP("GMRCR",$J,"RES",ND,"TEXT","GMRCRPT")) @TMPGLOB@(GMRCCT,0)=GMRCDVL_GMRCDVL,GMRCCT=GMRCCT+1
  1. . S:$O(^TMP("GMRCR",$J,"RES",ND,"TEXT",0)) @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
  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
  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
  1. . . S @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
  1. . . S @TMPGLOB@(GMRCCT,0)=TAB_"ADDENDUM TO REPORT",GMRCCT=GMRCCT+1
  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
  1. . . Q
  1. . Q
  1. K ^TMP("GMRCR",$J,"RES")
  1. Q
  1. ;
  1. GETCOM ;Get the comments for resolution actions
  1. S GMRCSTS=$P($G(^GMR(123,+GMRCO,0)),"^",12)
  1. Q:'$$RESOLUS^GMRCAU(+GMRCSTS)
  1. ;
  1. ;Loop thru actions to find the resolution type actions
  1. N ND,ND1,ND2
  1. S ND="" F S ND=$O(^GMR(123,+GMRCO,40,"B",ND)) Q:ND="" S ND1=$O(^GMR(123,+GMRCO,40,"B",ND,"")) D
  1. . ;
  1. . ;Check for resulting action types:complete,sig finding,dc,cancel
  1. . N GMRCAIEN
  1. . S GMRCAIEN=$P($G(^GMR(123,+GMRCO,40,ND1,0)),"^",2)
  1. . I '$$RESOLUA^GMRCAU(GMRCAIEN) Q
  1. . ;
  1. . ;save the action header info in case there are comments
  1. . N GMRCAHDR,GMRCPROV,GMRCENBY,GMRCENDT
  1. . D SAVEHDR
  1. . ;
  1. . ;check for comments, print header on first pass
  1. . S ND2=0
  1. . F S ND2=$O(^GMR(123,GMRCO,40,ND1,1,ND2)) Q:ND2="" D
  1. . . I +$G(GMRCAHDR) D GETHDR ;GMRCAHDR will =1 on first pass
  1. . . S @TMPGLOB@(GMRCCT,0)=^GMR(123,GMRCO,40,ND1,1,ND2,0),GMRCCT=GMRCCT+1
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. SAVEHDR ;Save the action header info to print later if there are comments
  1. S GMRCAHDR=1 ;flag to print action header on first pass of comments
  1. ;save the provider, entered by and date
  1. S GMRCPROV=$P(^GMR(123,GMRCO,40,ND1,0),"^",4),GMRCENBY=$P(^(0),"^",5)
  1. S GMRCENDT=$$FMTE^XLFDT($P($G(^GMR(123,GMRCO,40,ND1,0)),"^",3))
  1. Q
  1. ;
  1. GETHDR ;Print the comment header if the action had a comment
  1. S @TMPGLOB@(GMRCCT,0)="",GMRCCT=GMRCCT+1
  1. S @TMPGLOB@(GMRCCT,0)=$$CENTER^GMRCP5D("("_$P($G(^GMR(123.1,GMRCAIEN,0)),"^",8)_" Comment)"),GMRCCT=GMRCCT+1
  1. S @TMPGLOB@(GMRCCT,0)=" Entered by: "_$S($L(GMRCENBY):$P(^VA(200,GMRCENBY,0),"^",1),1:"")_" - "_GMRCENDT,GMRCCT=GMRCCT+1
  1. I +GMRCPROV S @TMPGLOB@(GMRCCT,0)=" Responsible Clinician: "_$P($G(^VA(200,GMRCPROV,0)),"^",1),GMRCCT=GMRCCT+1
  1. K GMRCAHDR
  1. Q
  1. ;
  1. GETREMOT(GMRCDA,GMRCAR,GMRCNT) ;retrieve remote results and load up in display
  1. ; Input:
  1. ; GMRCDA = consult ien from file 123
  1. ; GMRCAR = array to return results in (e.g. $NA(^TMP("GMRCAR",$J)) )
  1. ; GMRCNT = number within GMRCAR to start placing results (pass by ref)
  1. ;
  1. ;Output:
  1. ; array containing remote results in format:
  1. ; ^TMP("GMRCAR",$J,1,0)= result text line 1
  1. ; ^TMP("GMRCAR",$J,2,0)= result text line 2
  1. ;
  1. I '$O(^GMR(123,GMRCDA,51,0)) Q ;no remote results
  1. N HDR,GMRCREM,GMRCDATA,FTR,GMRCIO
  1. S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
  1. S HDR=$$REPEAT^XLFSTR("*",31)_" REMOTE RESULTS "_$$REPEAT^XLFSTR("*",31)
  1. S FTR=$$REPEAT^XLFSTR("*",27)_" END OF REMOTE RESULTS "_$$REPEAT^XLFSTR("*",28)
  1. S @GMRCAR@(GMRCNT,0)=HDR,GMRCNT=GMRCNT+1
  1. S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
  1. S GMRCREM=0 F S GMRCREM=$O(^GMR(123,GMRCDA,51,GMRCREM)) Q:'GMRCREM D
  1. . N GMRCSITE,GMRCRES,GMRCSTA,GMRCRPC,GMRCREM0
  1. . S GMRCREM0=^GMR(123,GMRCDA,51,GMRCREM,0) Q:'$L(GMRCREM0)
  1. . S GMRCSTA=$$STA^XUAF4($P(GMRCREM0,U,3))
  1. . D F4^XUAF4(GMRCSTA,.GMRCSITE) I '+GMRCSITE Q
  1. . ;BL; Need to check if site has been converted to Cerner and if so route properly
  1. . ; S:$$CNVTD^GMRCIEVT(+GMRCSITE) GMRCSTA="200CRNR"
  1. . S:$$CNVTD^GMRCIEVT(GMRCDA) GMRCSTA="200CRNR"
  1. . ;
  1. . S GMRCRES=$P(GMRCREM0,U,2)_","
  1. . I GMRCRES["TIU" S GMRCRPC="TIU GET RECORD TEXT",GMRCRES=+GMRCRES
  1. . ;BL;If this is a converted site add the the ICN to the string
  1. . N DFN,ICN ;MKN 171 changed K DFN,ICN to N DFN,ICN
  1. . I GMRCSTA["200CRNR" D
  1. . . S DFN=$P(^GMR(123,GMRCDA,0),"^",2)
  1. . . S ICN=$$GETICN^MPIF001(DFN)
  1. . . S GMRCRES=ICN_"\"_GMRCRES
  1. . ;
  1. . I GMRCRES["MCAR" S GMRCRPC="ORQQCN GET MED RESULT DETAILS"
  1. . D SAVDEV^%ZISUTL("GMRCIO") ; save off current device settings
  1. . D DIRECT^XWB2HL7(.GMRCDATA,GMRCSTA,GMRCRPC,"0",GMRCRES)
  1. . D USE^%ZISUTL("GMRCIO") ; restore IO to previous settings
  1. . D RMDEV^%ZISUTL("GMRCIO") ; kills data saved in GMRCIO
  1. . I '$D(GMRCDATA) Q
  1. . S @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR($S(GMRCRES["MCAR":"Medicine report from:",1:"TIU Document from:"),80),GMRCNT=GMRCNT+1
  1. . S @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR(GMRCSITE("NAME"),80)
  1. . S GMRCNT=GMRCNT+1
  1. . S @GMRCAR@(GMRCNT,0)=$$CJ^XLFSTR("Associated on: "_$$FMTE^XLFDT(+GMRCREM0),80),GMRCNT=GMRCNT+1
  1. . S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
  1. . N GMRCQT S GMRCQT=0
  1. . I '$L($G(GMRCDATA)) D
  1. .. N I S I="" F S I=$O(GMRCDATA(I)) Q:I=""!(GMRCQT) D
  1. ... I $P(GMRCDATA(I),U)=-1 D S GMRCQT=1 Q
  1. .... S @GMRCAR@(GMRCNT,0)="Report not currently available"
  1. .... S GMRCNT=GMRCNT+1
  1. ... S @GMRCAR@(GMRCNT,0)=GMRCDATA(I),GMRCNT=GMRCNT+1
  1. . I $L($G(GMRCDATA)),$D(@GMRCDATA) D
  1. .. N I S I="" F S I=$O(@GMRCDATA@(I)) Q:I=""!(GMRCQT) D
  1. ... I $P(@GMRCDATA@(I),U)=-1 D S GMRCQT=1 Q
  1. .... S @GMRCAR@(GMRCNT,0)="Report not currently available"
  1. .... S GMRCNT=GMRCNT+1
  1. ... S @GMRCAR@(GMRCNT,0)=@GMRCDATA@(I),GMRCNT=GMRCNT+1
  1. .. K @GMRCDATA
  1. . K GMRCDATA
  1. . Q
  1. S @GMRCAR@(GMRCNT,0)="",GMRCNT=GMRCNT+1
  1. S @GMRCAR@(GMRCNT,0)=FTR,GMRCNT=GMRCNT+1
  1. S @GMRCAR@(GMRCNT,0)=""
  1. Q
  1. ;
  1. END ;kill off variables and exit
  1. I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
  1. K DTOUT,DIROUT,DUOUT
  1. S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
  1. Q