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