- 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 Feb 18, 2025@23:14:02 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 ;