source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCPSL2.m@ 1671

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1GMRCPSL2 ;SLC/MA - Special Consult Reports;9/21/01 05:25 ;1/17/02 18:19
2 ;;3.0;CONSULT/REQUEST TRACKING;**23,22**;DEC 27, 1997
3 ; This routine is used by GMRCPSL1 to build ^TMP("GMRCRPT",$J)
4 ; which will be passed to GMRCPSL3.
5PRINT(GMRCSRCH,GMRCARRY,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCRPT,GMRCBRK) ; Untasked Print
6PRTTSK ; Print report
7 ; GMRCARRY = Array contains search values.
8 ; GMRCSRCH = Indicates which field to search on
9 ; GMRCDT1 = Start date
10 ; GMRCDT2 = Stop date
11 ; GMRCSTAT = CPRS status to include in report
12 ; SUBTOT = Counter for different groups
13 ; GMRCRPT = 80 - 132 character report & data only output
14 ; GMRCBRK = Print page break between sub-totals <Y-N>
15 ; TOTCNTR = Count for total records
16 I GMRCSRCH=1 D BLDPROV(.GMRCARRY) ;BLD PROVIDER ^TMP(GLOBAL)
17 I GMRCSRCH=2 D BLDLOC(.GMRCARRY) ;BLD LOCATION ^TMP(GLOBAL)
18 I GMRCSRCH=3 D BLDPROC(.GMRCARRY) ;BLD PROCEDURE ^TMP(GLOBAL)
19 N TOTCNTR,SUBTOT S (SUBTOT,TOTCNTR)=0
20 I GMRCRPT=1 D REPORT80^GMRCPSL3(.SUBTOT,.TOTCNTR,GMRCSRCH,GMRCBRK)
21 I GMRCRPT=2 D REPORT32^GMRCPSL3(.SUBTOT,.TOTCNTR,GMRCSRCH,GMRCBRK)
22 I GMRCRPT=3 D DATAONLY^GMRCPSL4 Q
23 W !!,"SUB TOTAL= ",SUBTOT,!
24 W !,"TOTAL RECORDS= ",TOTCNTR
25 D ^%ZISC
26 K ^TMP("GMRCRPT",$J)
27 I ($E(IOST)="C") D
28 .N DIR
29 .S DIR(0)="E"
30 .W !
31 .D ^DIR K DIR
32 Q
33 ;
34BLDLOC(GMRCARRY) ; Build ^TMP were search was on location.
35 K ^TMP("GMRCRPT",$J)
36 N GMRCCNTR,LOCATION,GMRCSRT1,GMRCSRT2,GMRCLOC1,GMRCLOC2,IEN
37 N GMRCREM,LOCPN
38 S GMRCCNTR=0
39 ;
40 ; get all Locations by date range
41 I GMRCARRY(1)="ALL" D
42 . S GMRCLOC1=GMRCDT1,GMRCLOC2=GMRCDT2
43 . F S GMRCLOC1=$O(^GMR(123,"E",GMRCLOC1)) Q:GMRCLOC1>GMRCLOC2 Q:GMRCLOC1="" D
44 . . S IEN=0
45 . . F S IEN=$O(^GMR(123,"E",GMRCLOC1,IEN)) Q:IEN'>0 D
46 . . . ;
47 . . . ; Check for Patient Location
48 . . . I "LB"[GMRCARRY,$$CKSTAT(IEN,GMRCSTAT),+$P(^GMR(123,IEN,0),"^",4) D Q
49 . . . . S LOCATION=$P(^GMR(123,IEN,0),"^",4) ; PATIENT LOCATION
50 . . . . S GMRCSRT1=$$GET1^DIQ(44,LOCATION,.01) ; PATIENT LOCATION
51 . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
52 . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
53 . . . ;
54 . . . ; If no patient location, check for Ordering Facility
55 . . . I $$CKSTAT(IEN,GMRCSTAT),'+$P(^GMR(123,IEN,0),"^",4),+$P(^GMR(123,IEN,0),"^",21),("L"[GMRCARRY&'+$P(^GMR(123,IEN,0),"^",23)!("RB"[GMRCARRY&+$P(^GMR(123,IEN,0),"^",23))) D Q
56 . . . . S LOCATION=$P(^GMR(123,IEN,0),"^",21) ;ORDERING FACILITY
57 . . . . S GMRCSRT1=$$GET1^DIQ(4,LOCATION,.01) ;ORDERING FACILITY
58 . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ;DATE OF REQUEST
59 . . . . S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
60 . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
61 . . . ;
62 . . . ; If no patient location & NO Ordering Facility, then
63 . . . ; check for Routing Facility
64 . . . I "RB"[GMRCARRY,$$CKSTAT(IEN,GMRCSTAT),'+$P(^GMR(123,IEN,0),"^",4),'+$P(^GMR(123,IEN,0),"^",21),+$P(^GMR(123,IEN,0),"^",23) D Q
65 . . . . S LOCATION=$P(^GMR(123,IEN,0),"^",23) ;ROUTING FACILITY
66 . . . . S GMRCSRT1=$$GET1^DIQ(4,LOCATION,.01) ;ROUTING FACILITY
67 . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ;DATE OF REQUEST
68 . . . . S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
69 . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
70 ; Get location list from GMRCARRY and then go to global using location
71 I GMRCARRY(1)="ALL" Q
72 F S GMRCCNTR=$O(GMRCARRY(GMRCCNTR)) Q:'GMRCCNTR D
73 . S LOCATION=$P(GMRCARRY(GMRCCNTR),"^",1)
74 . I "LB"[GMRCARRY,$P(GMRCARRY(GMRCCNTR),"^",3)=44 D
75 . . N IEN S IEN=0
76 . . F S IEN=$O(^GMR(123,"AL",LOCATION,IEN)) Q:IEN'>0 D
77 . . . I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
78 . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2) ; Patient Location
79 . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
80 . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
81 . I "RB"[GMRCARRY,$P(GMRCARRY(GMRCCNTR),"^",3)=4 D
82 . . S GMRCLOC1=GMRCDT1,GMRCLOC2=GMRCDT2
83 . . F S GMRCLOC1=$O(^GMR(123,"E",GMRCLOC1)) Q:GMRCLOC1>GMRCLOC2 Q:GMRCLOC1="" D
84 . . . N IEN S IEN=0
85 . . . F S IEN=$O(^GMR(123,"E",GMRCLOC1,IEN)) Q:IEN'>0 D
86 . . . . I $$CKSTAT(IEN,GMRCSTAT),$P($G(^GMR(123,IEN,12)),"^",5)="F",+$P($G(^GMR(123,IEN,0)),"^",21)=LOCATION D Q
87 . . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2)
88 . . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)
89 . . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
90 . . . . I $$CKSTAT(IEN,GMRCSTAT),$P($G(^GMR(123,IEN,12)),"^",5)="F",'+$P(^GMR(123,IEN,0),"^",21),+$P($G(^GMR(123,IEN,0)),"^",23)=LOCATION D Q
91 . . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2)
92 . . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)
93 . . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
94 Q
95BLDPROC(GMRCARRY) ; Build ^TMP were search was on procedure.
96 K ^TMP("GMRCRPT",$J)
97 N GMRCCNTR,PROCEDUR,GMRCSRT1,GMRCSRT2,GMRCPRC1,GMRCPRC2,IEN,GMRCREM
98 S GMRCCNTR=0
99 ; get all Procedures by date range
100 I GMRCARRY(1)="ALL" D
101 . S GMRCPRC1=GMRCDT1,GMRCPRC2=GMRCDT2
102 . F S GMRCPRC1=$O(^GMR(123,"E",GMRCPRC1)) Q:GMRCPRC1>GMRCPRC2 Q:GMRCPRC1="" D
103 . . S IEN=0
104 . . F S IEN=$O(^GMR(123,"E",GMRCPRC1,IEN)) Q:IEN'>0 D
105 . . . I $$CKSTAT(IEN,GMRCSTAT) D ; Ck Status
106 . . . . I $P(^GMR(123,IEN,0),"^",8)>"" D ; Ck for Proc
107 . . . . . S PROCEDUR=$P($P(^GMR(123,IEN,0),"^",8),";",1)
108 . . . . . S GMRCSRT1=$$GET1^DIQ(123.3,PROCEDUR,.01) ;Procedure
109 . . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ;Req Date
110 . . . . . S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
111 . . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
112 ; Get each procedure from GMRCARRY and then go to global using procedure
113 I GMRCARRY(1)="ALL" Q
114 F S GMRCCNTR=$O(GMRCARRY(GMRCCNTR)) Q:'GMRCCNTR D
115 . S PROCEDUR=$P(GMRCARRY(GMRCCNTR),"^",1)
116 . N IEN S IEN=0
117 . F S IEN=$O(^GMR(123,"AP",PROCEDUR_";GMR(123.3,",IEN)) Q:IEN'>0 D
118 . . I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
119 . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2) ; PROCEDURE TYPE
120 . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
121 . . . S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
122 . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
123 Q
124BLDPROV(GMRCARRY) ; Build ^TMP were search was on provider.
125 K ^TMP("GMRCRPT",$J)
126 N GMRCCNTR,PROVIDER,GMRCSRT1,GMRCSRT2,GMRCPRV1,GMRCPRV2,IEN
127 N GMRCPROV
128 S GMRCCNTR=0
129 ; get all providers by date range
130 I GMRCARRY(1)="ALL" D
131 . S GMRCPRV1=GMRCDT1,GMRCPRV2=GMRCDT2
132 . F S GMRCPRV1=$O(^GMR(123,"E",GMRCPRV1)) Q:GMRCPRV1>GMRCPRV2 Q:GMRCPRV1="" D
133 . . S IEN=0
134 . . F S IEN=$O(^GMR(123,"E",GMRCPRV1,IEN)) Q:IEN'>0 D
135 . . . ; Provider not null
136 . . . I "LB"[GMRCARRY,$$CKSTAT(IEN,GMRCSTAT) D
137 . . . . I +$P(^GMR(123,IEN,0),"^",14) D
138 . . . . . S GMRCPROV=$P(^GMR(123,IEN,0),"^",14) ; SENDING PROVIDER
139 . . . . . S GMRCSRT1=$$GET1^DIQ(200,GMRCPROV,.01) ; SENDING PROVIDER
140 . . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
141 . . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
142 . . . ; Provider null and REMOTE ORDERING PROVIDER not
143 . . . I "RB"[GMRCARRY,$$CKSTAT(IEN,GMRCSTAT) D
144 . . . . I '+$P(^GMR(123,IEN,0),"^",14),$P($G(^GMR(123,IEN,12)),"^",6)'="" D
145 . . . . . S GMRCPROV=$P($G(^GMR(123,IEN,12)),"^",6)
146 . . . . . S GMRCSRT1=GMRCPROV
147 . . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
148 . . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCPROV
149 ; Get provider list from GMRCARRY and then go to global using provider
150 I GMRCARRY(1)="ALL" Q
151 F S GMRCCNTR=$O(GMRCARRY(GMRCCNTR)) Q:'GMRCCNTR D
152 . S PROVIDER=$P(GMRCARRY(GMRCCNTR),"^",1)
153 . I "LB"[GMRCARRY,$P(GMRCARRY(GMRCCNTR),"^",3)=200 D
154 . . S IEN=0
155 . . F S IEN=$O(^GMR(123,"G",PROVIDER,IEN)) Q:IEN'>0 D
156 . . . I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
157 . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2) ; SENDING PROVIDER
158 . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
159 . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
160 . I "RB"[GMRCARRY,'$P(GMRCARRY(GMRCCNTR),"^",2) D
161 . . S IEN=0
162 . . F S IEN=$O(^GMR(123,"AIP",PROVIDER,IEN)) Q:IEN'>0 D
163 . . . I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
164 . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",1)
165 . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)
166 . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_PROVIDER
167 Q
168CKSTAT(IEN,GMRCSTAT) ; Does entry have selected status
169 ; Input:
170 ; IEN = File #123 IEN
171 ; GMRCSTAT = Selected status(es)
172 ; Output:
173 ; GMRCKS = Result (1:yes; 0:no)
174 N GMRCKS,GMRCS,LOOP,STATUS
175 S GMRCKS=0
176 S GMRCS=+$P(^GMR(123,IEN,0),"^",12)
177 F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) Q:GMRCKS D
178 . I STATUS=GMRCS S GMRCKS=1
179 Q GMRCKS
Note: See TracBrowser for help on using the repository browser.