| 1 | GMRCPSL1 ;SLC/MA - Special Consult Reports;9/21/01 05:25 ;1/10/02 14:26
|
|---|
| 2 | ;;3.0;CONSULT/REQUEST TRACKING;**23,22**;DEC 27, 1997
|
|---|
| 3 | ; This is the main entry routine for the Consult Reports that
|
|---|
| 4 | ; allow a user to search for consults by: Provider, Location,
|
|---|
| 5 | ; or Procedure. Also the user may select a date range and
|
|---|
| 6 | ; Consult status.
|
|---|
| 7 | ; The routines will not let the user search on any Inter-Facility
|
|---|
| 8 | ; information but will will use IFC when local fields are not present
|
|---|
| 9 | EN ;
|
|---|
| 10 | ; GMRCARRY = used for entering more than one search value.
|
|---|
| 11 | ; This array will be used by all the diff searches.
|
|---|
| 12 | ; GMRCDT1 = Start date
|
|---|
| 13 | ; GMRCDT2 = Stop date
|
|---|
| 14 | ; GMRCEND = If equal to one end routine
|
|---|
| 15 | ; GMRCSRCH = Indicates which field to search on
|
|---|
| 16 | ; GMRCSTAT = Indicates which CPRS status to include
|
|---|
| 17 | ; GMRCRPT = 80 - 132 character report & data only output
|
|---|
| 18 | ; GMRCBRK = Print page break between sub-totals <Y-N>
|
|---|
| 19 | N GMRCDT1,GMRCDT2,GMRCARRY,GMRCSRCH,GMRCEND,GMRCSTAT,GMRCRPT,GMRCBRK
|
|---|
| 20 | N GMRCQUIT
|
|---|
| 21 | S (GMRCBRK,GMRCQUIT,GMRCEND)=0
|
|---|
| 22 | S GMRCSRCH=$$GETSRCH ; Get search sequence
|
|---|
| 23 | I GMRCSRCH=1 D ; Get Provider
|
|---|
| 24 | . D GETPROV(.GMRCARRY) D
|
|---|
| 25 | . . I '$D(GMRCARRY(1)) D WARNING
|
|---|
| 26 | ;
|
|---|
| 27 | I GMRCSRCH=2 D ; Get Location
|
|---|
| 28 | . D GETLOC(.GMRCARRY) D
|
|---|
| 29 | . . I '$D(GMRCARRY(1)) D WARNING
|
|---|
| 30 | ;
|
|---|
| 31 | I GMRCSRCH=3 D ; Get Procedure
|
|---|
| 32 | . D GETPROC(.GMRCARRY) D
|
|---|
| 33 | . . I '$D(GMRCARRY) D WARNING
|
|---|
| 34 | I GMRCEND=1 K GMRCEND Q
|
|---|
| 35 | S GMRCRPT=$$TYPERPT Q:GMRCRPT=0 ; Get type or print
|
|---|
| 36 | I GMRCRPT'=3 S GMRCBRK=$$PAGEBRK ; Break between sub-totals
|
|---|
| 37 | I GMRCBRK>1 Q
|
|---|
| 38 | D GETDATE I GMRCQUIT Q ; Get Date
|
|---|
| 39 | I '$D(GMRCDT2) Q
|
|---|
| 40 | S GMRCDT2=GMRCDT2+1
|
|---|
| 41 | ;
|
|---|
| 42 | ;
|
|---|
| 43 | S GMRCSTAT=$$STS^GMRCPC1 Q:'GMRCSTAT ; Get search CPRS status
|
|---|
| 44 | ;
|
|---|
| 45 | I GMRCRPT=0 Q
|
|---|
| 46 | ;
|
|---|
| 47 | D DEVICE ; Get printer device
|
|---|
| 48 | ;
|
|---|
| 49 | ; At this point all user input has been collected
|
|---|
| 50 | ;
|
|---|
| 51 | I $D(IO("Q")) D QUEUE Q
|
|---|
| 52 | ;
|
|---|
| 53 | ; Go build ^TMP("GMRCRPT",$J) using user input variables &
|
|---|
| 54 | ; write report
|
|---|
| 55 | D PRINT^GMRCPSL2(GMRCSRCH,.GMRCARRY,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCRPT,GMRCBRK) ;Report writer
|
|---|
| 56 | KILL DIR,DIC,^TMP("GMRCRPT",$J)
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | CHECK(GMRCDAT) ;CHECK FREE TEXT INPUT
|
|---|
| 60 | N %DT,X,Y
|
|---|
| 61 | I $E("ALL DATES",1,$L(GMRCDAT))=$$UP^XLFSTR(GMRCDAT) Q "ALL"
|
|---|
| 62 | S %DT="E",X=GMRCDAT D ^%DT I Y<1 Q 0
|
|---|
| 63 | Q +Y
|
|---|
| 64 | I '$D(GMRCDT1) Q
|
|---|
| 65 | I GMRCDT1="ALL" S GMRCDT1=0000000,GMRCDT2=9999999
|
|---|
| 66 | Q
|
|---|
| 67 | DEVICE ; device for printout of entries to group update
|
|---|
| 68 | N %ZIS,POP
|
|---|
| 69 | I GMRCRPT=2 D
|
|---|
| 70 | . W !!,"You must configure your terminal so that it"
|
|---|
| 71 | . W " will support 132 character"
|
|---|
| 72 | . W !,"emulation and reply 132 to the right margin setting if"
|
|---|
| 73 | . W " using HOME"
|
|---|
| 74 | . W !,"as the device."
|
|---|
| 75 | . W !,""
|
|---|
| 76 | I GMRCRPT=3 D
|
|---|
| 77 | . W !!,"OK, you have selected a TABLE output format."
|
|---|
| 78 | . W !,"You must use your personal computer's terminal emulation"
|
|---|
| 79 | . W !,"to capture the output:"
|
|---|
| 80 | . W !,""
|
|---|
| 81 | . W !," 1. Enter at the DEVICE: HOME// prompt "";250;99999999"
|
|---|
| 82 | . W !," and do not hit the enter key."
|
|---|
| 83 | . W !," 2. Open a capture file within your terminal emulation program."
|
|---|
| 84 | . W !," 3. Hit enter to start the down load."
|
|---|
| 85 | . W !," 4. Close the capture file when the output stops."
|
|---|
| 86 | . W !,""
|
|---|
| 87 | RETRY ;
|
|---|
| 88 | S %ZIS="MQ"
|
|---|
| 89 | D ^%ZIS
|
|---|
| 90 | I POP S GMRCEND=1 Q
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | GETDATE ;Get START and STOP dates
|
|---|
| 94 | ;GMRCDT1=Start date
|
|---|
| 95 | ;GMRCDT2=Stop date
|
|---|
| 96 | N DTOUT,DIR,DUOUT,DIRUT,X,Y
|
|---|
| 97 | GETDATE1 ;
|
|---|
| 98 | S DIR(0)="FA^1:45",DIR("A")="List From Starting Date (ALL): "
|
|---|
| 99 | S DIR("B")="T-30" D ^DIR
|
|---|
| 100 | I $D(DUOUT)!($D(DTOUT)) S GMRCQUIT=1 Q
|
|---|
| 101 | S GMRCDT1=$$CHECK(X)
|
|---|
| 102 | I 'GMRCDT1,GMRCDT1'="ALL" G GETDATE1
|
|---|
| 103 | I GMRCDT1="ALL" S GMRCDT1=0,GMRCDT2=9999999 Q
|
|---|
| 104 | K DIR
|
|---|
| 105 | S DIR(0)="DAO^::E",DIR("A")="List To This Ending Date: " D ^DIR
|
|---|
| 106 | I $D(DTOUT)!($D(DUOUT)) K GMRCDT1,GMRCDT2 Q
|
|---|
| 107 | I +Y=0 W "(NOW)" S GMRCDT2=$$DT^XLFDT Q
|
|---|
| 108 | I +Y<GMRCDT1 S GMRCDT2=GMRCDT1,GMRCDT1=+Y
|
|---|
| 109 | S:'$D(GMRCDT2) GMRCDT2=+Y
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | ; Get a Location
|
|---|
| 113 | GETLOC(GMRCARRY) ;
|
|---|
| 114 | ; DBIA 10040 call DIC=44
|
|---|
| 115 | N DIC,DIR,DIRUT,DUOUT,DTOUT,X,Y,GMRCCNTR,GMRCQLOC
|
|---|
| 116 | S GMRCCNTR=0
|
|---|
| 117 | S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 118 | S DIR("A")="Enter 'YES' if you want all LOCATIONS"
|
|---|
| 119 | W !,""
|
|---|
| 120 | D ^DIR
|
|---|
| 121 | W !,""
|
|---|
| 122 | I Y=1 S GMRCARRY(1)="ALL"
|
|---|
| 123 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 124 | S DIR(0)="SA^L:LOCAL;R:REMOTE;B:BOTH LOCAL AND REMOTE LOCATIONS"
|
|---|
| 125 | S DIR("A")=$S($D(GMRCARRY):"All ",1:"")_"(L)ocal, (R)emote, or (B)oth Local and Remote Locations: "
|
|---|
| 126 | S DIR("B")="Local"
|
|---|
| 127 | S DIR("?")="^D HELP^GMRCPSL1"
|
|---|
| 128 | D ^DIR I $D(DIRUT) S GMRCEND=1 Q
|
|---|
| 129 | S GMRCARRY=Y
|
|---|
| 130 | Q:$D(GMRCARRY(1))
|
|---|
| 131 | W !
|
|---|
| 132 | I "LB"[GMRCARRY D
|
|---|
| 133 | . S DIC=44,DIC(0)="AEMQ",DIC("A")="ENTER Local LOCATION: "
|
|---|
| 134 | . F D ^DIC Q:$D(DUOUT)!($D(DTOUT))!(Y<0) D
|
|---|
| 135 | . . S GMRCCNTR=GMRCCNTR+1
|
|---|
| 136 | . . S GMRCARRY(GMRCCNTR)=Y_"^"_44
|
|---|
| 137 | I "B"[GMRCARRY W !
|
|---|
| 138 | I "RB"[GMRCARRY D
|
|---|
| 139 | . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 140 | . S DIR(0)="PO^4:EMQ"
|
|---|
| 141 | . S DIR("S")="I $$STA^XUAF4(+Y)=+$$STA^XUAF4(+Y)"
|
|---|
| 142 | . S DIR("A")="ENTER Remote LOCATION"
|
|---|
| 143 | . S DIR("?")="For this report, Institution file (#4) entries are considered Remote locations."
|
|---|
| 144 | . F D ^DIR S:$D(DTOUT) GMRCEND=1 S:$D(DUOUT) GMRCEND=1 Q:$D(DIRUT) D
|
|---|
| 145 | . . S GMRCCNTR=GMRCCNTR+1
|
|---|
| 146 | . . S GMRCARRY(GMRCCNTR)=Y_"^"_4
|
|---|
| 147 | Q
|
|---|
| 148 | ;
|
|---|
| 149 | ; Get a Procedure
|
|---|
| 150 | GETPROC(GMRCARRY) ;
|
|---|
| 151 | N DIC,DIR,DIRUT,DUOUT,DTOUT,X,Y,GMRCCNTR,GMRCQPRC
|
|---|
| 152 | S GMRCCNTR=0
|
|---|
| 153 | S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 154 | S DIR("A")="Enter 'YES' if you want all PROCEDURES"
|
|---|
| 155 | W !,""
|
|---|
| 156 | D ^DIR
|
|---|
| 157 | W !,""
|
|---|
| 158 | I Y=1 S GMRCARRY(1)="ALL" Q
|
|---|
| 159 | S DIC=123.3,DIC(0)="AEMQ",DIC("A")="ENTER PROCEDURE: "
|
|---|
| 160 | F D ^DIC Q:$D(DUOUT)!($D(DTOUT))!(Y<0) D
|
|---|
| 161 | . S GMRCCNTR=GMRCCNTR+1
|
|---|
| 162 | . S GMRCARRY(GMRCCNTR)=Y
|
|---|
| 163 | Q
|
|---|
| 164 | ;
|
|---|
| 165 | ; Get a Provider name
|
|---|
| 166 | GETPROV(GMRCARRY) ;
|
|---|
| 167 | ; DBIA 10060 call DIC=200
|
|---|
| 168 | N DIC,DIRUT,DUOUT,DTOUT,X,Y,GMRCCNTR,GMRCQPRV
|
|---|
| 169 | S GMRCCNTR=0
|
|---|
| 170 | S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 171 | S DIR("A")="Enter 'YES' if you want all PROVIDERS"
|
|---|
| 172 | W !,""
|
|---|
| 173 | D ^DIR
|
|---|
| 174 | W !,""
|
|---|
| 175 | I Y=1 S GMRCARRY(1)="ALL"
|
|---|
| 176 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 177 | S DIR(0)="SA^L:LOCAL;R:REMOTE;B:BOTH LOCAL AND REMOTE PROVIDERS"
|
|---|
| 178 | S DIR("A")=$S($D(GMRCARRY):"All ",1:"")_"(L)ocal, (R)emote, or (B)oth Local and Remote Providers: "
|
|---|
| 179 | S DIR("B")="Local"
|
|---|
| 180 | S DIR("?")="^D HELP^GMRCPSL1"
|
|---|
| 181 | D ^DIR I $D(DIRUT) S GMRCEND=1 Q
|
|---|
| 182 | S GMRCARRY=Y
|
|---|
| 183 | Q:$D(GMRCARRY(1))
|
|---|
| 184 | W !
|
|---|
| 185 | I "LB"[GMRCARRY D
|
|---|
| 186 | . S DIC=200,DIC(0)="AEMQ",DIC("A")="ENTER Local PROVIDER: "
|
|---|
| 187 | . F D ^DIC Q:$D(DUOUT)!($D(DTOUT))!(Y<0) D
|
|---|
| 188 | . . S GMRCCNTR=GMRCCNTR+1
|
|---|
| 189 | . . S GMRCARRY(GMRCCNTR)=Y_"^"_200
|
|---|
| 190 | I "B"[GMRCARRY W !
|
|---|
| 191 | I "RB"[GMRCARRY D
|
|---|
| 192 | . N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 193 | . S DIR(0)="FO^2:40^D UP^GMRCA2 K:'$D(^GMR(123,""AIP"",X)) X"
|
|---|
| 194 | . S DIR("?")="^D HELPR^GMRCIR,HELPR^GMRCPSL1"
|
|---|
| 195 | . S DIR("A")="ENTER Remote PROVIDER"
|
|---|
| 196 | . F D ^DIR S:$D(DTOUT) GMRCEND=1 S:$D(DUOUT) GMRCEND=1 Q:$D(DIRUT) D
|
|---|
| 197 | . . D UP^GMRCA2 S Y=X
|
|---|
| 198 | . . S GMRCCNTR=GMRCCNTR+1
|
|---|
| 199 | . . S GMRCARRY(GMRCCNTR)=Y
|
|---|
| 200 | Q
|
|---|
| 201 | HELP ; Help for location and provider prompts
|
|---|
| 202 | W !!?3,"""Local"" refers to non-Inter-facility requests and Inter-"
|
|---|
| 203 | W !?3,"facility requests originating locally."
|
|---|
| 204 | W !?3,"""Remote"" only refers to Inter-facility requests originating"
|
|---|
| 205 | W !?3,"at another site."
|
|---|
| 206 | Q
|
|---|
| 207 | HELPR ; Help for remote provider prompt
|
|---|
| 208 | W:$Y>(IOSL-4) @IOF
|
|---|
| 209 | W !!?3,"Enter the ENTIRE name in proper CASE, exactly as it"
|
|---|
| 210 | W !?3,"appears in the above list (including any credentials)."
|
|---|
| 211 | W !?3,"Use copy/paste to avoid typing errors."
|
|---|
| 212 | W !?3,"NO partial matches are done."
|
|---|
| 213 | W !
|
|---|
| 214 | Q
|
|---|
| 215 | GETSRCH() ; What search criteria should report be in???
|
|---|
| 216 | N DIR,Y,X
|
|---|
| 217 | S DIR("A",1)="Enter Search criteria:"
|
|---|
| 218 | S DIR("A",2)=""
|
|---|
| 219 | S DIR("A",3)=" 1 = Sending Provider"
|
|---|
| 220 | S DIR("A",4)=" 2 = Location"
|
|---|
| 221 | S DIR("A",5)=" 3 = Procedure"
|
|---|
| 222 | S DIR("A",6)=""
|
|---|
| 223 | S DIR("A")="Search criteria"
|
|---|
| 224 | S DIR("B")=1
|
|---|
| 225 | S DIR(0)="NO^1:3"
|
|---|
| 226 | D ^DIR
|
|---|
| 227 | I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)) S GMRCEND=1
|
|---|
| 228 | Q Y
|
|---|
| 229 | ;
|
|---|
| 230 | PAGEBRK() ; Does user want page breaks between sub-totals?
|
|---|
| 231 | N DIR
|
|---|
| 232 | S DIR(0)="Y"
|
|---|
| 233 | S DIR("A")="Display sort sequence & page breaks between sub-totals"
|
|---|
| 234 | S DIR("B")="YES"
|
|---|
| 235 | D ^DIR I $D(DIRUT) Q 2
|
|---|
| 236 | Q +Y
|
|---|
| 237 | TYPERPT() ; Get type of report to print
|
|---|
| 238 | N DIR
|
|---|
| 239 | S DIR(0)="SO^1:80 column;2:132 column;3:Table Export"
|
|---|
| 240 | S DIR("L",1)="Please select an output format from the following:"
|
|---|
| 241 | S DIR("L",2)=""
|
|---|
| 242 | S DIR("L",3)="1 - 80 column standard print [STANDARD]"
|
|---|
| 243 | S DIR("L",4)="2 - 132 column standard print"
|
|---|
| 244 | S DIR("L")="3 - Table without headers (export to another application)"
|
|---|
| 245 | S DIR("B")=1
|
|---|
| 246 | D ^DIR I $D(DIRUT)!(Y>3) Q 0
|
|---|
| 247 | Q +Y
|
|---|
| 248 | ;
|
|---|
| 249 | QUEUE ; send task for print and update
|
|---|
| 250 | N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTSK
|
|---|
| 251 | S ZTRTN="PRTTSK^GMRCPSL2",ZTDESC="PRINT OF RECORDS FILE 123"
|
|---|
| 252 | S ZTIO=ION
|
|---|
| 253 | S ZTSAVE("GMRC*")=""
|
|---|
| 254 | D ^%ZTLOAD I $G(ZTSK) W !,"Task # ",ZTSK
|
|---|
| 255 | I '$G(ZTSK) W !,"Unable to queue report! Try again later."
|
|---|
| 256 | Q
|
|---|
| 257 | WARNING ; Let user know that they did not enter any data.
|
|---|
| 258 | W !!,"No search criteria was entered" H 1
|
|---|
| 259 | S GMRCEND=1
|
|---|
| 260 | Q
|
|---|
