source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSLM1.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: 7.5 KB
Line 
1GMRCSLM1 ;SLC/DCM - Gather data and format ^TMP global for consult tracking Silent call for use by List Manager and GUI ;10/9/01 23:12
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,10,12,15,17,22,32**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #2638,#2740
5 ;
6 G AD
7SVC(NODE) ;Check for a valid service
8 K GMRCDEAV
9 I '$D(^GMR(123,NODE,0)) Q 0
10 I '+$P(^GMR(123,NODE,0),"^",5) Q 0
11 I '$D(^TMP("GMRCS",$J,$P(^GMR(123,NODE,0),"^",5))) Q 0
12 Q 1
13AD ;Main entry point. Loop through AD x-ref in file 123; Find consults that have been released to requested service
14 ;;DFN and GMRCSSNM must be defined when this entry point is called
15 ;;DFN=Internal File Number of Patient in ^DPT
16 ;;GMRCSSNM=Service Name of a Hospital Service from file ^GMR(123.5
17 ;;If GMRCSSNM is not defined or is null, then no records will be found.
18 ;;GMRCOER must be passed so that proper formatting for GUI or List Manager can be performed. GMRCOER is passed as 0 for List Manager, 1 for GUI.
19 ;;GMRCDT1 and GMRCDT2 are passed in as start and stop dates for the lookup. If GMRCDT1="" or GMRCDT1="ALL", then all dates are searched.
20 ;;GMRCIS=IFC site (if defined); Values: R(equesting) or C(onsulting)
21 ;; ***********************************************************
22 K ^TMP("GMRCR",$J,"CS"),GMRCNUL
23 I $D(GMRCSSS) S (GMRCDG,GMRCSS)=GMRCSSS,GMRCSSNM=($P($G(^GMR(123.5,+GMRCSS,0)),"^",1)) D SERV1^GMRCASV K GMRCSSS ;reset after forward
24 S TAB="",$P(TAB," ",41)="",BLK=0,LNCT=1 S:'$D(GMRCOER) GMRCOER=0
25 S GMRCD=0 F S GMRCD=$O(^GMR(123,"AD",DFN,GMRCD)) Q:'GMRCD S GMRCDA=0 F S GMRCDA=$O(^GMR(123,"AD",DFN,GMRCD,GMRCDA)) Q:'GMRCDA I $$SVC(GMRCDA) D SET
26 D END Q
27SET ;;Format entries into a word processing 'TMP("GMRCR",$J,"CS",' global that List Manager can display
28 ;;GMRCOER is a variable that signals that data is being formatted for the OE/RR GUI; this data is formatted differently than the data for List Manager.
29 ;;GMRCOER=0 : Data is List Manager formatted.
30 ;;GMRCOER=1 : Data is OE/RR GUI formatted.
31 S:'$D(TAB) TAB="",$P(TAB," ",30)=""
32 S GMRCIFN=$G(GMRCDA) I '$L(GMRCIFN),$D(XQADATA) S (GMRCDA,GMRCIFN)=+XQADATA
33 S GMRCSEX=$S($P(^DPT(DFN,0),"^",2)="M":"MALE",1:"FEMALE")
34 I '$D(^GMR(123,+GMRCIFN,0)) S GMRCQUT=1 Q
35 S PROC="",GMRC(0)=^GMR(123,GMRCIFN,0)
36 ;IF Consults
37 N GMRCCK
38 I $D(GMRCIS) D Q:'GMRCCK
39 . S GMRCCK=1
40 . S:'$P($G(GMRC(0)),"^",23) GMRCCK=0
41 . I GMRCCK=1 D
42 . . S GMRC(12)=$G(^GMR(123,GMRCIFN,12))
43 . . I GMRCIS="R",$P(GMRC(12),"^",5)'="P" S GMRCCK=0
44 . . I GMRCIS="C",$P(GMRC(12),"^",5)'="F" S GMRCCK=0
45 I $D(GMRCSTCK),GMRCSTCK'="" N STATUS,TITLE D Q:'STATUS
46 . N I
47 . F I=1:1 S STATUS=$P(GMRCSTCK,",",I) Q:STATUS=$P(GMRC(0),"^",12) Q:'STATUS
48 . Q
49 I $D(GMRCVP),GMRCVP'=$P(GMRC(0),"^",8) Q
50 S (GMRCFMDT,X)=$P(GMRC(0),"^",7) I GMRCDT1'="ALL",$P(X,".",1)<GMRCDT1!($P(X,".",1)>GMRCDT2) Q
51 I GMRCOER'=2 D
52 . S BLK=BLK+1
53 . S ^TMP("GMRCR",$J,"CS","AD",BLK,LNCT,GMRCDA)=""
54 D REGDTM^GMRCU S CDT=$P(X," ")
55 S PROC=$S($P(GMRC(0),U,17)="P":"Procedure",1:"Consult")
56 I PROC'="Consult" S PROC=$$GET1^DIQ(123.3,+$P(GMRC(0),"^",8),.01)
57 S:PROC="" PROC="Consult"
58 S TO=+$P(GMRC(0),"^",5)
59 I +TO S TOD=$S($P($G(^GMR(123.5,+TO,0)),"^",2)=9:1,1:0)
60 I '$D(TOD) S TOD=0
61 S TO=$S(+TO:$P($G(^GMR(123.5,+TO,0)),"^",1),1:"")
62 S TO=$S(TOD:"<",1:"")_TO
63 S TO=$S(GMRCOER:TO,1:$E(TO,1,40))_$S(TOD:">",1:"")
64 I '$L(TO) S TO="**Unknown Service**"
65 S STS=$P(GMRC(0),"^",12) D
66 . I '+STS,'$D(^ORD(100.01,+STS,0)) Q
67 . I '+GMRCOER S STS=$P(^ORD(100.01,+STS,.1),"^",1) Q
68 . I GMRCOER=1 S STS=$P(^ORD(100.01,+STS,0),"^") Q
69 . S STS=$P(^ORD(100.01,+STS,.1),"^")
70 I $S(STS="":1,'$D(^ORD(100.01,+$P(GMRC(0),"^",12),0)):1,1:0) S STS=99,$P(GMRC(0),"^",12)=STS,STS=$S(GMRCOER=1:$P(^ORD(100.01,5,0),"^",1),1:$P(^ORD(100.01,+STS,.1),"^",1))
71 D SERVPROC
72 I 'GMRCOER D Q
73 . S ^TMP("GMRCR",$J,"CS",LNCT,0)=BLK_$E(TAB,1,(4-$L(BLK)))_CDT_" "_$E(STS,1,3)_$S(STS?1A:" ",STS?2A:" ",1:"")_" "_$J(GMRCDA,7)_" "_$S($P(GMRC(0),"^",19)="Y":"*",1:" ")_TITLE
74 . S LNCT=LNCT+1
75 I GMRCOER D
76 . N DATA
77 . S DATA=GMRCDA_U_GMRCFMDT_U_STS_U_TO_U_PROC_U
78 . S DATA=DATA_$S($P(GMRC(0),U,19)="Y":"*",1:"")_U
79 . S DATA=DATA_TITLE_U_$P(GMRC(0),U,3)
80 . D ;get type of record for proper icon in GUI
81 .. ; "C"=reg cons, "P"=reg proc, "M"=clin proc, "I"=IF cons, "R"=IF proc
82 .. I +$G(^GMR(123,GMRCDA,1)) S $P(DATA,U,9)="M" Q
83 .. S $P(DATA,U,9)=$P(GMRC(0),U,17)
84 .. N GMRCGVER
85 .. S GMRCGVER=$P($G(ORWCLVER),".",3,4) ;GUI version running
86 .. I GMRCGVER'>19.1 Q ;will crash at less than 19.1
87 .. I $P(GMRC(0),U,23) S $P(DATA,U,9)=$S($P(DATA,U,9)="P":"R",1:"I")
88 . S ^TMP("GMRCR",$J,"CS",LNCT,0)=DATA
89 . S LNCT=LNCT+1
90 . K STSOER Q
91 Q
92END I LNCT<2 S (BLK,LNCT,GMRCNUL)=1,GMRCNPM="< PATIENT DOES NOT HAVE ANY CONSULTS/REQUESTS "_$S($D(GMRCPRNM):"FOR "_GMRCPRNM,1:"")_" ON FILE. >",GMRCNPM=$E(TAB,1,(80-$L(GMRCNPM))\80)_GMRCNPM,^TMP("GMRCR",$J,"CS",LNCT,0)=GMRCNPM D
93 .I $D(GMRCDT1)&($D(GMRCDT2)),GMRCDT1'="ALL" S LNCT=LNCT+1,^TMP("GMRCR",$J,"CS",LNCT,0)="Between Dates: "_$$FMTE^XLFDT(GMRCDT1)_" and "_$$FMTE^XLFDT(GMRCDT2)
94 .I $D(GMRCSTCK),$L(GMRCSTCK) S LNCT=LNCT+1,^TMP("GMRCR",$J,"CS",LNCT,0)="With Status: " S STS="" F I=1:1 S STS=$P(GMRCSTCK,",",I) Q:STS="" S ^TMP("GMRCR",$J,"CS",LNCT,0)=^(0)_$P($G(^ORD(100.01,+STS,0)),"^",1)_" "
95 .Q
96 E S (BLK,LNCT)=LNCT-1,^TMP("GMRCR",$J,"CS",0)="^^^"_LNCT
97 I $D(GMRCALFL) S (BLK,LNCT)=1
98 K TO,TOD,END,FLG,GMRC(0),GMRCD,GMRCDG,GMRCIFN,GMRCFMDT,GMRCNPM,GMRCWARD
99 K I,PROC,STS,URG
100 Q
101OER(DFN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTCK,GMRCOER) ;;GUI interface for CPRS
102 ;;DFN=Patient internal file number
103 ;;GMRCDG: Internal file number of consult service from file 123.5
104 ;;GMRCDT1: Beginning date for lookup
105 ;;GMRCDT2: Ending date for lookup
106 ;;GMRCSTCK: IEN from OER Status File [^OER(100.01)] to screen results
107 ;; so that only consults with a desired status are displayed
108 ;; Can be sent as a set of statuses: i.e., 6,5,2
109 ;; (GMRCSTCK=GMRC STATUS CHECK)
110 ;;GMRCOER=0 if request is from CONSULTS
111 ;; =1 if request is for CPRS List Manager
112 ;; =2 if for CPRS GUI
113 I GMRCDT1="" S GMRCDT1="ALL"
114 I GMRCDG="" S GMRCDG=$O(^GMR(123.5,"B","ALL SERVICES",0))
115 S:'$D(GMRCOER) GMRCOER=1
116 D SERV1^GMRCASV,AD
117 K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)
118 Q
119SERVPROC ; Build contents of SERV/PROC field for List Manager
120 N TYPE,OTXT
121 S TITLE=""
122 S TYPE=""
123 S OTXT=$P($G(^GMR(123,GMRCDA,1.11)),"^")
124 I OTXT="" D BUILD2
125 I OTXT'="" D BUILD1
126 Q
127BUILD1 ;OTXT does contain information
128 N FLG,BADFLG,TPROC,TTO,LEN,ABBRS,ABBRP
129 S TPROC=$$UP^XLFSTR(PROC),TTO=$$UP^XLFSTR(TO)
130 S TITLE=OTXT,OTXT=$$UP^XLFSTR(OTXT)
131 S BADFLG=0
132 I PROC="Consult" S FLG=1,TYPE="Cons"
133 I PROC'="Consult" S FLG=0,TYPE="Proc"
134 S LEN=$L(TITLE)
135 I TO="" S TO="No Service"
136 I LEN<30,FLG=1,OTXT'=TTO S TITLE=TITLE_" "_TO_" "_TYPE Q
137 I LEN<30,FLG=1,OTXT=TTO S TITLE=TITLE_" "_TYPE Q
138 I TO["<" S BADFLG=1
139 S ABBRS=$$SVC^GMRCAU(GMRCDA),ABBRP=$$PROC^GMRCAU(GMRCDA)
140 I LEN<30,FLG=0,TPROC'=OTXT,TTO'=TPROC S TITLE=TITLE_" "_PROC_" "_TO_" "_TYPE Q
141 I LEN<30,FLG=0,TPROC=OTXT,TTO'=TPROC S TITLE=TITLE_" "_TO_" "_TYPE Q
142 I LEN<30,FLG=0,TPROC=OTXT,TTO=TPROC S TITLE=TITLE_" "_TYPE Q
143 I LEN>30,FLG=1,TTO'=OTXT S TITLE=TITLE_" "_TO_" "_TYPE Q
144 I LEN>30,FLG=1,TTO=OTXT S TITLE=TITLE_" "_TYPE Q
145 I LEN>30,FLG=0,TPROC'=OTXT,TTO'=TPROC S TITLE=TITLE_" "_ABBRP_" "_TYPE Q
146 I LEN>30,FLG=0,TTO'=OTXT,BADFLG=0 S TITLE=TITLE_" "_ABBRS_" "_TYPE Q
147 I LEN>30,FLG=0,TTO'=OTXT,BADFLG=1 S TITLE=TITLE_" "_"<"_ABBRS_">"_TYPE Q
148 Q
149BUILD2 ;OTXT contains no information
150 N FLG,TPROC,TTO,LEN
151 S TPROC=$$UP^XLFSTR(PROC),TTO=$$UP^XLFSTR(TO)
152 I PROC="Consult" S TITLE=TO,LEN=$L(TITLE),FLG=1,TYPE="Cons"
153 I PROC'="Consult" S TITLE=PROC,LEN=$L(TITLE),FLG=0,TYPE="Proc"
154 I FLG=1 S TITLE=TITLE_" "_TYPE Q
155 I FLG=0,TTO=TPROC S TITLE=TITLE_" "_TYPE Q
156 I FLG=0,TTO'=TPROC S TITLE=TITLE_" "_TO_" "_TYPE Q
157 Q
Note: See TracBrowser for help on using the repository browser.