source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCTIUP.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1GMRCTIUP ;SLC/DCM,JFR - TIU/Consults UTILITIES; 4/4/01 15:01
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,13,15,17,22**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #616,#2693
5 ;
6HDR(GMRCTUPR,GMRCGLB,COUNT,FROM) ;Get Source info for header of display
7 ;and place data in ^TMP( global. Do Not Show Any Results
8 ;GMRCTUPR=TIU record being sought
9 ;GMRCGLOB=Global where data goes - i.e., ^TMP("GMRCR",$J,"RES",GMRCPTR,"ADD",GMRCADD,LINECT,0)
10 ;COUNT=Count of where current line is to go in ^TMP( global
11 ;FROM=flag to tell whether to add Addendum TIU # or not 0=NO, Otherwise addendum number
12 N DR,GMRCTMP
13 S:'$D(FROM) FROM=""
14 S DR=".01;.05;.07;.09;1201;1202;1204;1205;1208;1301;1302",GMRCERR=""
15 D EXTRACT^TIULQ(GMRCPTR,"LOCAL",.GMRCERR,DR)
16 S @GMRCGLB@(COUNT,0)="",COUNT=COUNT+1
17 S @GMRCGLB@(COUNT,0)="Source Information",COUNT=COUNT+1,@GMRCGLB@(COUNT,0)=""
18 S @GMRCGLB@(COUNT,0)=" Document Status: "_LOCAL(GMRCPTR,.05,"E"),COUNT=COUNT+1
19 S @GMRCGLB@(COUNT,0)=" Entry Date: "_$P($G(LOCAL(GMRCPTR,1201,"E")),":",1,2),COUNT=COUNT+1
20 S @GMRCGLB@(COUNT,0)=" Visit: "_$G(LOCAL(GMRCPTR,.07,"E"))_" "_$G(LOCAL(GMRCPTR,1205,"E"))
21 S COUNT=COUNT+1
22 S @GMRCGLB@(COUNT,0)=" Author: "_LOCAL(GMRCPTR,1202,"E")
23 S COUNT=COUNT+1
24 S @GMRCGLB@(COUNT,0)=" Expected Signer: "_$E(LOCAL(GMRCPTR,1204,"E")_TAB,1,22)_$E(TAB,1,5)_"Expected Cosigner: "_$S($L($G(LOCAL(GMRCPTR,1208,"E"))):LOCAL(GMRCPTR,1208,"E"),1:"None"),COUNT=COUNT+1
25 S @GMRCGLB@(COUNT,0)=" Entered By: "_$E(LOCAL(GMRCPTR,1302,"E")_TAB,1,30)_"TIU Document #: "_GMRCTUPR,COUNT=COUNT+1
26 S @GMRCGLB@(COUNT,0)=$S(+FROM:" TIU Addendum Document #: "_FROM,1:"")_$S(+FROM:$E(TAB,1,10),1:" ")_" Urgency: "_$S($L($G(LOCAL(GMRCPTR,.09,"E"))):LOCAL(GMRCPTR,.09,"E"),1:"None"),COUNT=COUNT+1
27 S @GMRCGLB@(COUNT,0)="",COUNT=COUNT+1
28 K LOCAL
29 Q
30PRINT(GMRCO,LINECT,GMRCRT,GMRCDET) ;get TIU results and prepare for the SF-513
31 ;GMRCRT=Flag from RT^GMRCA1 indicating that result request is from there
32 ; GMRCRT=0 means 'NO',
33 ; GMRCRT=1 means 'YES" (and ES is appended to TIU main result); also,
34 ; No result is passed back to print on the 513 if GMRCRT=0.
35 ;GMRCTUFN=IEN of the TIU result from file 8925
36 ;GMRCSIG=signature block name of signer : GMRCSDT=date result was signed
37 ;GMRCSIGT=signers block title : GMRCTUFN=TIU IEN of the result record
38 ;GMRCCSIG=cosigners block name : GMRCCSDT=date cosigner signed
39 ;GMRCCTIT=cosigners block title : GMRCSIGM=Signature mode (E:ELECTRONIC/C:CHART)
40 ;I GMRCDET=1 coming from a detailed display not results display
41 N GMRCTUFN,TAB,GLOBAL
42 S:'$D(GMRCRT) GMRCRT=0 S:'$D(GMRCDET) GMRCDET=0
43 D GETRSLTS(GMRCO,.GMRCAR) ;I $D(GMRCQUT) D:$D(GMRCMSG) EXAC^GMRCADC(GMRCMSG) K GMRCMSG,GMRCRT Q
44 S GLOBAL="^TMP(""GMRCR"",$J,""GMRCTIU"")",TAB="",$P(TAB," ",31)=""
45 K ^TMP("GMRCR",$J,"RES"),^TMP("GMRCR",$J,"MCAR")
46 S (GMRCND,GMRCPTR)="" F K @GLOBAL S GMRCND=$O(GMRCAR(GMRCND)) Q:GMRCND="" S GMRCPKG=$P(GMRCND,";",2),GMRCPTR=$P(GMRCND,";",1) D
47 .I $E(GMRCPKG,1,3)="TIU" D
48 .. N GMRCTXT,GMRCPAR,GMRCACTN
49 .. D EXTRACT^TIULQ(GMRCPTR,"GMRCPAR",.GMRCERR,.06,"I")
50 .. I $D(GMRCAR(+$G(GMRCPAR(GMRCPTR,.06,"I"))_";TIU(8925,")) Q
51 .. S GMRCACTN=$S($G(GMRCRT):"VIEW",1:"PRINT RECORD")
52 .. D TGET^TIUSRVR1(.GMRCTXT,+GMRCPTR,GMRCACTN)
53 .. I $D(@(GMRCTXT)) M @GLOBAL@(GMRCPTR,"TEXT")=@GMRCTXT
54 .. K @GMRCTXT
55 .. I $O(@GLOBAL@(GMRCPTR,"TEXT",0)) D
56 ...S ND=0 F S ND=$O(@GLOBAL@(GMRCPTR,"TEXT",ND)) Q:ND="" D
57 ....S ^TMP("GMRCR",$J,"RES",GMRCPTR,"TEXT",LINECT,0)=@GLOBAL@(GMRCPTR,"TEXT",ND)
58 ....S LINECT=LINECT+1
59 ..Q
60 .I $E(GMRCPKG,1,4)="MCAR" S GMRCSR=GMRCND,MCFILE=$P(GMRCSR,";",2),MCFILE=$P(MCFILE,","),MCPROC=$O(^MCAR(697.2,"C",MCFILE,"")) Q:'MCPROC D
61 ..S GMRCPRNM=$P(^MCAR(697.2,MCPROC,0),"^",8),ORIFN=$P(^GMR(123,GMRCO,0),"^",3),ORACTION=8,MCGLOBAL="^TMP(""GMRCR"",$J,""MCAR"","_GMRCPTR_")"
62 ..D EN^GMRCTIU3(GMRCO,ORIFN,MCGLOBAL,LINECT) K ^TMP("MC",$J)
63 ..Q
64 .Q
65 ; inter-facility remote results
66 I 'GMRCDET,$O(^GMR(123,GMRCO,51,0)) D
67 .N GMRCTMP S GMRCTMP="^TMP(""GMRCR"",$J,""RRES"")" K @GMRCTMP
68 .S GLOBAL="^TMP(""GMRCR"",$J,""GMRCRRES"")" K @GLOBAL
69 .D GETREMOT^GMRCART(GMRCO,GMRCTMP,LINECT)
70 .I $D(@(GMRCTMP)) M @GLOBAL@(.5,"TEXT")=@GMRCTMP K @GMRCTMP
71 .I $O(@GLOBAL@(.5,"TEXT",0)) D
72 ..S ND=0 F S ND=$O(@GLOBAL@(.5,"TEXT",ND)) Q:ND="" D
73 ...S ^TMP("GMRCR",$J,"RES",.5,"TEXT",LINECT,0)=@GLOBAL@(.5,"TEXT",ND,0)
74 ...S LINECT=LINECT+1
75 .Q
76 K DR,GLOBAL,GMRCSR,GMRCAR,GMRCPKG,GMRCPRNM,MCFILE,MCPROC,ORACTION,ORIFN,MCGLOBAL,ND,ND1,GMRCND,GMRCPTR
77 Q
78GETNOTE(GMRCO,FILE) ;Get the last result added to the record - this is found in $P(^(0),"^",20)
79 ;Function returns last note added to record.
80 ;If it does not contain the file pointer, it is assumed that
81 ;it pointed to the TIU file 8925
82 ;GMRCO=file 123 IEN
83 ;FILE='MCAR' to get last medicine result pointer
84 ;FILE='TIU' to get last TIU result pointer
85 N X,RSLT
86 S RSLT=999999,X=""
87 F S RSLT=$O(^GMR(123,+GMRCO,50,RSLT),-1) Q:'RSLT D Q:+X
88 . I $G(^GMR(123,+GMRCO,50,RSLT,0))[FILE S X=^GMR(123,+GMRCO,50,RSLT,0)
89 Q X
90GETRSLTS(GMRCO,ARRAY) ;Get the results from record and return it in array 'ARRAY')
91 ;Looks for results in $P(^(0),"^",20),$P(^(0),"^",15) and Field 50 multiple
92 ;GMRCO=File 123 IEN
93 ;ARRAY=array to return results pointers in
94 ;ARRAY will be returned as ARRAY("IEN;FILE"), as e.g., "1289;^TIU(8925,"
95 N X
96 S X=$$GETNOTE(GMRCO,"TIU") I $L(X) S:$P(X,";",2)="" X=X_";TIU(8925," S ARRAY(X)=""
97 S X=$$GETNOTE(GMRCO,"MCAR") I $L(X) S ARRAY(X)=""
98 S X="" F S X=$O(^GMR(123,GMRCO,50,"B",X)) Q:X?1A.E!(X="") S ARRAY(X)=""
Note: See TracBrowser for help on using the repository browser.