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

GMRCTIUL.m

Go to the documentation of this file.
  1. GMRCTIUL ;SLC/DCM,DLT - Get list of existing results for consults ;5/01/98 10:09
  1. ;;3.0;CONSULT/REQUEST TRACKING;**4,14,15**;DEC 27, 1997
  1. ;
  1. ; This routine invokes IA #2834
  1. ;
  1. GETLIST(GMRCO,GETWHAT,TYPE,GMRCNT) ;Get the count and list of results
  1. ;Input variables:
  1. ;GMRCO=consult entry from 123
  1. ;GETWHAT=how much to return
  1. ; 0 = count only returned
  1. ; 1 = count + ^TMP internal values from TIU
  1. ; 2 = count + ^TMP internal values from TIU
  1. ; + ^TMP display format array
  1. ;TYPE=what type of results to return
  1. ; 0=all types
  1. ; 1=TIU only
  1. ; 2=Medicine results only
  1. ;returns GMRCNT() = result count
  1. ; ^TMP("GMRC50",$J,GMRCRVP,GMRCRIEN)=summary data from source
  1. ; where GMRCRVP is the variable pointer value
  1. ; where GMRCRIEN is the entry in the 50th node
  1. ; ^TMP("GMRC50R",$J,GMRCRIEN)= external list for review
  1. N COUNT,GMRCRIEN,TAB
  1. K ^TMP("GMRC50",$J),^TMP("GMRC50R",$J),GMRCNT
  1. S (COUNT,GMRCRIEN)=0,GMRCNT(0)=COUNT
  1. S TAB="",$P(TAB," ",30)=""
  1. ;Get results from the result multiple
  1. F S GMRCRIEN=$O(^GMR(123,+GMRCO,50,GMRCRIEN)) Q:'GMRCRIEN D I $G(GMRCQUT) K GMRCQUT Q
  1. . S GMRCRVP=$P($G(^GMR(123,+GMRCO,50,+GMRCRIEN,0)),"^",1) I GMRCRVP="" S GMRCQUT=1 Q
  1. . D UPDCNT
  1. . Q
  1. ;Get TIU NARRATIVE RESULT if the result multiple is not loaded yet
  1. I COUNT=0,'$D(^GMR(123,+GMRCO,50)),+$P(^GMR(123,+GMRCO,0),"^",20) D
  1. . S GMRCRVP=$P($G(^GMR(123,+GMRCO,0)),"^",20)_";TIU(8925,"
  1. . D UPDCNT
  1. . Q
  1. S GMRCNT(0)=COUNT
  1. Q
  1. ;
  1. UPDCNT ;Update count of existing results for the consult and build array
  1. S GMRCVF=$P(GMRCRVP,";",2)
  1. I '$G(GMRCNT(GMRCVF)) S GMRCNT(GMRCVF)=0
  1. S COUNT=COUNT+1
  1. S GMRCNT(GMRCVF)=GMRCNT(GMRCVF)+1
  1. I +GETWHAT,TYPE=1 D TIUTMP(+GETWHAT)
  1. Q
  1. ;
  1. TIUTMP(GETWHAT) ;build ^TMP array for results based on TIU when type=1
  1. I $G(GMRCRVP)["MCAR" D Q
  1. .S COUNT=COUNT-1
  1. .S GMRCNT(GMRCVF)=GMRCNT(GMRCVF)-1
  1. S ^TMP("GMRC50",$J,GMRCRVP,COUNT)=$$RESOLVE^TIUSRVLO(+GMRCRVP)
  1. Q:GETWHAT=1 ;get internal value global
  1. N GMRCRDAT,GMRCDOCT,GMRCEDT,GMRCAUTH,GMRCSTS,GMRCTX
  1. S GMRCRDAT=^TMP("GMRC50",$J,GMRCRVP,COUNT)
  1. S GMRCDOCT=$E($P(GMRCRDAT,"^",1),1,19)
  1. S GMRCEDT=$$FMTE^XLFDT($P(GMRCRDAT,U,2),"D")
  1. S GMRCAUTH=$E($P($G(^VA(200,+$P(GMRCRDAT,"^",4),0)),U,1),1,12)
  1. S GMRCSTS=$E($P(GMRCRDAT,"^",6),1,5)
  1. S GMRCTX=$J(COUNT,3)_"> "_$E(GMRCDOCT_TAB,1,20)_$E("#"_+GMRCRVP_TAB,1,9)_$E(GMRCEDT_TAB,1,13)_$E(GMRCAUTH_TAB,1,14)_$E(GMRCSTS_TAB,1,6)_$E("#"_+$P(GMRCRDAT,"^",9)_TAB,1,10)
  1. S ^TMP("GMRC50R",$J,COUNT,GMRCRVP)=GMRCTX
  1. Q
  1. ;
  1. PROCTMP ;build ^TMP array for procedure results when type note=1
  1. Q:TYPE=1
  1. Q
  1. ;
  1. SHOWTIU ;Display the current TIU results available
  1. N GMRCRVP,GMRCRCT
  1. W !,"Notes associated with this consult:",!
  1. W !," No. Document Title TIU Entered Author Sts Consult"
  1. S GMRCRCT=0
  1. F S GMRCRCT=$O(^TMP("GMRC50R",$J,GMRCRCT)) Q:'+GMRCRCT D
  1. . S GMRCRVP=$O(^TMP("GMRC50R",$J,GMRCRCT,""))
  1. . W !,^TMP("GMRC50R",$J,GMRCRCT,GMRCRVP)
  1. Q
  1. SELR(GMRCRCT) ;Select a note from the list
  1. ;Input GMRCNT=array with the count of TIU notes
  1. I '+$G(GMRCRCT("TIU(8925,")),'+$O(^TMP("GMRC50R",$J,0)) S GMRCMSG="No results available" D EXAC^GMRCADC(GMRCMSG) K GMRCMSG Q 0
  1. ;Select a note
  1. N DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIR("A")="Select an existing note"
  1. S DIR(0)="NO^1:"_GMRCRCT("TIU(8925,")
  1. D ^DIR
  1. Q +Y
  1. LN1 ;Used by filemanager print template to format line
  1. S:'$G(COUNT) COUNT=1
  1. S GMRCVF="TIU(8925,",GMRCNT(GMRCVF)=1,TAB=" "
  1. S GMRCRVP=+($G(^GMR(123,D0,50,D1,0)))
  1. Q:'GMRCRVP
  1. N GMRCDOCT,GMRCEDT
  1. S GMRCRDAT=$$RESOLVE^TIUSRVLO(+GMRCRVP)
  1. S GMRCDOCT=$E($P(GMRCRDAT,"^",1),1,19)
  1. S GMRCEDT=$$FMTE^XLFDT(GMRCRDAT,"D")
  1. S GMRCTX=$E("#"_+GMRCRVP_TAB,1,9)_$E(GMRCDOCT_TAB,1,22)_$E(GMRCEDT_TAB,1,13)_$P(GMRCRDAT,U,3)
  1. W GMRCTX
  1. Q
  1. LN2 ;Used by Fileman to write second line
  1. N GMRCAUTH,GMRCSTS
  1. S GMRCAUTH=$E($P($G(^VA(200,+$P(GMRCRDAT,"^",4),0)),U,1),1,12)
  1. S GMRCSTS=$E($P(GMRCRDAT,"^",6),1,5)
  1. S GMRCTX=$E(TAB,1,5)_$E("Author: "_GMRCAUTH_TAB,1,16)_$E(GMRCSTS_TAB,1,8)_$E("#"_+$P(GMRCRDAT,"^",9)_TAB,1,10)
  1. W GMRCTX
  1. Q
  1. ;