source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCTIUL.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1GMRCTIUL ;SLC/DCM,DLT - Get list of existing results for consults ;5/01/98 10:09
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,14,15**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #2834
5 ;
6GETLIST(GMRCO,GETWHAT,TYPE,GMRCNT) ;Get the count and list of results
7 ;Input variables:
8 ;GMRCO=consult entry from 123
9 ;GETWHAT=how much to return
10 ; 0 = count only returned
11 ; 1 = count + ^TMP internal values from TIU
12 ; 2 = count + ^TMP internal values from TIU
13 ; + ^TMP display format array
14 ;TYPE=what type of results to return
15 ; 0=all types
16 ; 1=TIU only
17 ; 2=Medicine results only
18 ;returns GMRCNT() = result count
19 ; ^TMP("GMRC50",$J,GMRCRVP,GMRCRIEN)=summary data from source
20 ; where GMRCRVP is the variable pointer value
21 ; where GMRCRIEN is the entry in the 50th node
22 ; ^TMP("GMRC50R",$J,GMRCRIEN)= external list for review
23 N COUNT,GMRCRIEN,TAB
24 K ^TMP("GMRC50",$J),^TMP("GMRC50R",$J),GMRCNT
25 S (COUNT,GMRCRIEN)=0,GMRCNT(0)=COUNT
26 S TAB="",$P(TAB," ",30)=""
27 ;Get results from the result multiple
28 F S GMRCRIEN=$O(^GMR(123,+GMRCO,50,GMRCRIEN)) Q:'GMRCRIEN D I $G(GMRCQUT) K GMRCQUT Q
29 . S GMRCRVP=$P($G(^GMR(123,+GMRCO,50,+GMRCRIEN,0)),"^",1) I GMRCRVP="" S GMRCQUT=1 Q
30 . D UPDCNT
31 . Q
32 ;Get TIU NARRATIVE RESULT if the result multiple is not loaded yet
33 I COUNT=0,'$D(^GMR(123,+GMRCO,50)),+$P(^GMR(123,+GMRCO,0),"^",20) D
34 . S GMRCRVP=$P($G(^GMR(123,+GMRCO,0)),"^",20)_";TIU(8925,"
35 . D UPDCNT
36 . Q
37 S GMRCNT(0)=COUNT
38 Q
39 ;
40UPDCNT ;Update count of existing results for the consult and build array
41 S GMRCVF=$P(GMRCRVP,";",2)
42 I '$G(GMRCNT(GMRCVF)) S GMRCNT(GMRCVF)=0
43 S COUNT=COUNT+1
44 S GMRCNT(GMRCVF)=GMRCNT(GMRCVF)+1
45 I +GETWHAT,TYPE=1 D TIUTMP(+GETWHAT)
46 Q
47 ;
48TIUTMP(GETWHAT) ;build ^TMP array for results based on TIU when type=1
49 I $G(GMRCRVP)["MCAR" D Q
50 .S COUNT=COUNT-1
51 .S GMRCNT(GMRCVF)=GMRCNT(GMRCVF)-1
52 S ^TMP("GMRC50",$J,GMRCRVP,COUNT)=$$RESOLVE^TIUSRVLO(+GMRCRVP)
53 Q:GETWHAT=1 ;get internal value global
54 N GMRCRDAT,GMRCDOCT,GMRCEDT,GMRCAUTH,GMRCSTS,GMRCTX
55 S GMRCRDAT=^TMP("GMRC50",$J,GMRCRVP,COUNT)
56 S GMRCDOCT=$E($P(GMRCRDAT,"^",1),1,19)
57 S GMRCEDT=$$FMTE^XLFDT($P(GMRCRDAT,U,2),"D")
58 S GMRCAUTH=$E($P($G(^VA(200,+$P(GMRCRDAT,"^",4),0)),U,1),1,12)
59 S GMRCSTS=$E($P(GMRCRDAT,"^",6),1,5)
60 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)
61 S ^TMP("GMRC50R",$J,COUNT,GMRCRVP)=GMRCTX
62 Q
63 ;
64PROCTMP ;build ^TMP array for procedure results when type note=1
65 Q:TYPE=1
66 Q
67 ;
68SHOWTIU ;Display the current TIU results available
69 N GMRCRVP,GMRCRCT
70 W !,"Notes associated with this consult:",!
71 W !," No. Document Title TIU Entered Author Sts Consult"
72 S GMRCRCT=0
73 F S GMRCRCT=$O(^TMP("GMRC50R",$J,GMRCRCT)) Q:'+GMRCRCT D
74 . S GMRCRVP=$O(^TMP("GMRC50R",$J,GMRCRCT,""))
75 . W !,^TMP("GMRC50R",$J,GMRCRCT,GMRCRVP)
76 Q
77SELR(GMRCRCT) ;Select a note from the list
78 ;Input GMRCNT=array with the count of TIU notes
79 I '+$G(GMRCRCT("TIU(8925,")),'+$O(^TMP("GMRC50R",$J,0)) S GMRCMSG="No results available" D EXAC^GMRCADC(GMRCMSG) K GMRCMSG Q 0
80 ;Select a note
81 N DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
82 S DIR("A")="Select an existing note"
83 S DIR(0)="NO^1:"_GMRCRCT("TIU(8925,")
84 D ^DIR
85 Q +Y
86LN1 ;Used by filemanager print template to format line
87 S:'$G(COUNT) COUNT=1
88 S GMRCVF="TIU(8925,",GMRCNT(GMRCVF)=1,TAB=" "
89 S GMRCRVP=+($G(^GMR(123,D0,50,D1,0)))
90 Q:'GMRCRVP
91 N GMRCDOCT,GMRCEDT
92 S GMRCRDAT=$$RESOLVE^TIUSRVLO(+GMRCRVP)
93 S GMRCDOCT=$E($P(GMRCRDAT,"^",1),1,19)
94 S GMRCEDT=$$FMTE^XLFDT(GMRCRDAT,"D")
95 S GMRCTX=$E("#"_+GMRCRVP_TAB,1,9)_$E(GMRCDOCT_TAB,1,22)_$E(GMRCEDT_TAB,1,13)_$P(GMRCRDAT,U,3)
96 W GMRCTX
97 Q
98LN2 ;Used by Fileman to write second line
99 N GMRCAUTH,GMRCSTS
100 S GMRCAUTH=$E($P($G(^VA(200,+$P(GMRCRDAT,"^",4),0)),U,1),1,12)
101 S GMRCSTS=$E($P(GMRCRDAT,"^",6),1,5)
102 S GMRCTX=$E(TAB,1,5)_$E("Author: "_GMRCAUTH_TAB,1,16)_$E(GMRCSTS_TAB,1,8)_$E("#"_+$P(GMRCRDAT,"^",9)_TAB,1,10)
103 W GMRCTX
104 Q
105 ;
Note: See TracBrowser for help on using the repository browser.