GMRCPSL1 ;SLC/MA - Special Consult Reports;9/21/01 05:25 ;1/10/02 14:26
;;3.0;CONSULT/REQUEST TRACKING;**23,22**;DEC 27, 1997
; This is the main entry routine for the Consult Reports that
; allow a user to search for consults by: Provider, Location,
; or Procedure. Also the user may select a date range and
; Consult status.
; The routines will not let the user search on any Inter-Facility
; information but will will use IFC when local fields are not present
EN ;
; GMRCARRY = used for entering more than one search value.
; This array will be used by all the diff searches.
; GMRCDT1 = Start date
; GMRCDT2 = Stop date
; GMRCEND = If equal to one end routine
; GMRCSRCH = Indicates which field to search on
; GMRCSTAT = Indicates which CPRS status to include
; GMRCRPT = 80 - 132 character report & data only output
; GMRCBRK = Print page break between sub-totals <Y-N>
N GMRCDT1,GMRCDT2,GMRCARRY,GMRCSRCH,GMRCEND,GMRCSTAT,GMRCRPT,GMRCBRK
N GMRCQUIT
S (GMRCBRK,GMRCQUIT,GMRCEND)=0
S GMRCSRCH=$$GETSRCH ; Get search sequence
I GMRCSRCH=1 D ; Get Provider
. D GETPROV(.GMRCARRY) D
. . I '$D(GMRCARRY(1)) D WARNING
;
I GMRCSRCH=2 D ; Get Location
. D GETLOC(.GMRCARRY) D
. . I '$D(GMRCARRY(1)) D WARNING
;
I GMRCSRCH=3 D ; Get Procedure
. D GETPROC(.GMRCARRY) D
. . I '$D(GMRCARRY) D WARNING
I GMRCEND=1 K GMRCEND Q
S GMRCRPT=$$TYPERPT Q:GMRCRPT=0 ; Get type or print
I GMRCRPT'=3 S GMRCBRK=$$PAGEBRK ; Break between sub-totals
I GMRCBRK>1 Q
D GETDATE I GMRCQUIT Q ; Get Date
I '$D(GMRCDT2) Q
S GMRCDT2=GMRCDT2+1
;
;
S GMRCSTAT=$$STS^GMRCPC1 Q:'GMRCSTAT ; Get search CPRS status
;
I GMRCRPT=0 Q
;
D DEVICE ; Get printer device
;
; At this point all user input has been collected
;
I $D(IO("Q")) D QUEUE Q
;
; Go build ^TMP("GMRCRPT",$J) using user input variables &
; write report
D PRINT^GMRCPSL2(GMRCSRCH,.GMRCARRY,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCRPT,GMRCBRK) ;Report writer
KILL DIR,DIC,^TMP("GMRCRPT",$J)
Q
;
CHECK(GMRCDAT) ;CHECK FREE TEXT INPUT
N %DT,X,Y
I $E("ALL DATES",1,$L(GMRCDAT))=$$UP^XLFSTR(GMRCDAT) Q "ALL"
S %DT="E",X=GMRCDAT D ^%DT I Y<1 Q 0
Q +Y
I '$D(GMRCDT1) Q
I GMRCDT1="ALL" S GMRCDT1=0000000,GMRCDT2=9999999
Q
DEVICE ; device for printout of entries to group update
N %ZIS,POP
I GMRCRPT=2 D
. W !!,"You must configure your terminal so that it"
. W " will support 132 character"
. W !,"emulation and reply 132 to the right margin setting if"
. W " using HOME"
. W !,"as the device."
. W !,""
I GMRCRPT=3 D
. W !!,"OK, you have selected a TABLE output format."
. W !,"You must use your personal computer's terminal emulation"
. W !,"to capture the output:"
. W !,""
. W !," 1. Enter at the DEVICE: HOME// prompt "";250;99999999"
. W !," and do not hit the enter key."
. W !," 2. Open a capture file within your terminal emulation program."
. W !," 3. Hit enter to start the down load."
. W !," 4. Close the capture file when the output stops."
. W !,""
RETRY ;
S %ZIS="MQ"
D ^%ZIS
I POP S GMRCEND=1 Q
Q
;
GETDATE ;Get START and STOP dates
;GMRCDT1=Start date
;GMRCDT2=Stop date
N DTOUT,DIR,DUOUT,DIRUT,X,Y
GETDATE1 ;
S DIR(0)="FA^1:45",DIR("A")="List From Starting Date (ALL): "
S DIR("B")="T-30" D ^DIR
I $D(DUOUT)!($D(DTOUT)) S GMRCQUIT=1 Q
S GMRCDT1=$$CHECK(X)
I 'GMRCDT1,GMRCDT1'="ALL" G GETDATE1
I GMRCDT1="ALL" S GMRCDT1=0,GMRCDT2=9999999 Q
K DIR
S DIR(0)="DAO^::E",DIR("A")="List To This Ending Date: " D ^DIR
I $D(DTOUT)!($D(DUOUT)) K GMRCDT1,GMRCDT2 Q
I +Y=0 W "(NOW)" S GMRCDT2=$$DT^XLFDT Q
I +Y<GMRCDT1 S GMRCDT2=GMRCDT1,GMRCDT1=+Y
S:'$D(GMRCDT2) GMRCDT2=+Y
Q
;
; Get a Location
GETLOC(GMRCARRY) ;
; DBIA 10040 call DIC=44
N DIC,DIR,DIRUT,DUOUT,DTOUT,X,Y,GMRCCNTR,GMRCQLOC
S GMRCCNTR=0
S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Enter 'YES' if you want all LOCATIONS"
W !,""
D ^DIR
W !,""
I Y=1 S GMRCARRY(1)="ALL"
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="SA^L:LOCAL;R:REMOTE;B:BOTH LOCAL AND REMOTE LOCATIONS"
S DIR("A")=$S($D(GMRCARRY):"All ",1:"")_"(L)ocal, (R)emote, or (B)oth Local and Remote Locations: "
S DIR("B")="Local"
S DIR("?")="^D HELP^GMRCPSL1"
D ^DIR I $D(DIRUT) S GMRCEND=1 Q
S GMRCARRY=Y
Q:$D(GMRCARRY(1))
W !
I "LB"[GMRCARRY D
. S DIC=44,DIC(0)="AEMQ",DIC("A")="ENTER Local LOCATION: "
. F D ^DIC Q:$D(DUOUT)!($D(DTOUT))!(Y<0) D
. . S GMRCCNTR=GMRCCNTR+1
. . S GMRCARRY(GMRCCNTR)=Y_"^"_44
I "B"[GMRCARRY W !
I "RB"[GMRCARRY D
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
. S DIR(0)="PO^4:EMQ"
. S DIR("S")="I $$STA^XUAF4(+Y)=+$$STA^XUAF4(+Y)"
. S DIR("A")="ENTER Remote LOCATION"
. S DIR("?")="For this report, Institution file (#4) entries are considered Remote locations."
. F D ^DIR S:$D(DTOUT) GMRCEND=1 S:$D(DUOUT) GMRCEND=1 Q:$D(DIRUT) D
. . S GMRCCNTR=GMRCCNTR+1
. . S GMRCARRY(GMRCCNTR)=Y_"^"_4
Q
;
; Get a Procedure
GETPROC(GMRCARRY) ;
N DIC,DIR,DIRUT,DUOUT,DTOUT,X,Y,GMRCCNTR,GMRCQPRC
S GMRCCNTR=0
S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Enter 'YES' if you want all PROCEDURES"
W !,""
D ^DIR
W !,""
I Y=1 S GMRCARRY(1)="ALL" Q
S DIC=123.3,DIC(0)="AEMQ",DIC("A")="ENTER PROCEDURE: "
F D ^DIC Q:$D(DUOUT)!($D(DTOUT))!(Y<0) D
. S GMRCCNTR=GMRCCNTR+1
. S GMRCARRY(GMRCCNTR)=Y
Q
;
; Get a Provider name
GETPROV(GMRCARRY) ;
; DBIA 10060 call DIC=200
N DIC,DIRUT,DUOUT,DTOUT,X,Y,GMRCCNTR,GMRCQPRV
S GMRCCNTR=0
S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Enter 'YES' if you want all PROVIDERS"
W !,""
D ^DIR
W !,""
I Y=1 S GMRCARRY(1)="ALL"
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="SA^L:LOCAL;R:REMOTE;B:BOTH LOCAL AND REMOTE PROVIDERS"
S DIR("A")=$S($D(GMRCARRY):"All ",1:"")_"(L)ocal, (R)emote, or (B)oth Local and Remote Providers: "
S DIR("B")="Local"
S DIR("?")="^D HELP^GMRCPSL1"
D ^DIR I $D(DIRUT) S GMRCEND=1 Q
S GMRCARRY=Y
Q:$D(GMRCARRY(1))
W !
I "LB"[GMRCARRY D
. S DIC=200,DIC(0)="AEMQ",DIC("A")="ENTER Local PROVIDER: "
. F D ^DIC Q:$D(DUOUT)!($D(DTOUT))!(Y<0) D
. . S GMRCCNTR=GMRCCNTR+1
. . S GMRCARRY(GMRCCNTR)=Y_"^"_200
I "B"[GMRCARRY W !
I "RB"[GMRCARRY D
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
. S DIR(0)="FO^2:40^D UP^GMRCA2 K:'$D(^GMR(123,""AIP"",X)) X"
. S DIR("?")="^D HELPR^GMRCIR,HELPR^GMRCPSL1"
. S DIR("A")="ENTER Remote PROVIDER"
. F D ^DIR S:$D(DTOUT) GMRCEND=1 S:$D(DUOUT) GMRCEND=1 Q:$D(DIRUT) D
. . D UP^GMRCA2 S Y=X
. . S GMRCCNTR=GMRCCNTR+1
. . S GMRCARRY(GMRCCNTR)=Y
Q
HELP ; Help for location and provider prompts
W !!?3,"""Local"" refers to non-Inter-facility requests and Inter-"
W !?3,"facility requests originating locally."
W !?3,"""Remote"" only refers to Inter-facility requests originating"
W !?3,"at another site."
Q
HELPR ; Help for remote provider prompt
W:$Y>(IOSL-4) @IOF
W !!?3,"Enter the ENTIRE name in proper CASE, exactly as it"
W !?3,"appears in the above list (including any credentials)."
W !?3,"Use copy/paste to avoid typing errors."
W !?3,"NO partial matches are done."
W !
Q
GETSRCH() ; What search criteria should report be in???
N DIR,Y,X
S DIR("A",1)="Enter Search criteria:"
S DIR("A",2)=""
S DIR("A",3)=" 1 = Sending Provider"
S DIR("A",4)=" 2 = Location"
S DIR("A",5)=" 3 = Procedure"
S DIR("A",6)=""
S DIR("A")="Search criteria"
S DIR("B")=1
S DIR(0)="NO^1:3"
D ^DIR
I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)) S GMRCEND=1
Q Y
;
PAGEBRK() ; Does user want page breaks between sub-totals?
N DIR
S DIR(0)="Y"
S DIR("A")="Display sort sequence & page breaks between sub-totals"
S DIR("B")="YES"
D ^DIR I $D(DIRUT) Q 2
Q +Y
TYPERPT() ; Get type of report to print
N DIR
S DIR(0)="SO^1:80 column;2:132 column;3:Table Export"
S DIR("L",1)="Please select an output format from the following:"
S DIR("L",2)=""
S DIR("L",3)="1 - 80 column standard print [STANDARD]"
S DIR("L",4)="2 - 132 column standard print"
S DIR("L")="3 - Table without headers (export to another application)"
S DIR("B")=1
D ^DIR I $D(DIRUT)!(Y>3) Q 0
Q +Y
;
QUEUE ; send task for print and update
N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTSK
S ZTRTN="PRTTSK^GMRCPSL2",ZTDESC="PRINT OF RECORDS FILE 123"
S ZTIO=ION
S ZTSAVE("GMRC*")=""
D ^%ZTLOAD I $G(ZTSK) W !,"Task # ",ZTSK
I '$G(ZTSK) W !,"Unable to queue report! Try again later."
Q
WARNING ; Let user know that they did not enter any data.
W !!,"No search criteria was entered" H 1
S GMRCEND=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCPSL1 8785 printed Sep 23, 2025@19:22:56 Page 2
GMRCPSL1 ;SLC/MA - Special Consult Reports;9/21/01 05:25 ;1/10/02 14:26
+1 ;;3.0;CONSULT/REQUEST TRACKING;**23,22**;DEC 27, 1997
+2 ; This is the main entry routine for the Consult Reports that
+3 ; allow a user to search for consults by: Provider, Location,
+4 ; or Procedure. Also the user may select a date range and
+5 ; Consult status.
+6 ; The routines will not let the user search on any Inter-Facility
+7 ; information but will will use IFC when local fields are not present
EN ;
+1 ; GMRCARRY = used for entering more than one search value.
+2 ; This array will be used by all the diff searches.
+3 ; GMRCDT1 = Start date
+4 ; GMRCDT2 = Stop date
+5 ; GMRCEND = If equal to one end routine
+6 ; GMRCSRCH = Indicates which field to search on
+7 ; GMRCSTAT = Indicates which CPRS status to include
+8 ; GMRCRPT = 80 - 132 character report & data only output
+9 ; GMRCBRK = Print page break between sub-totals <Y-N>
+10 NEW GMRCDT1,GMRCDT2,GMRCARRY,GMRCSRCH,GMRCEND,GMRCSTAT,GMRCRPT,GMRCBRK
+11 NEW GMRCQUIT
+12 SET (GMRCBRK,GMRCQUIT,GMRCEND)=0
+13 ; Get search sequence
SET GMRCSRCH=$$GETSRCH
+14 ; Get Provider
IF GMRCSRCH=1
Begin DoDot:1
+15 DO GETPROV(.GMRCARRY)
Begin DoDot:2
+16 IF '$DATA(GMRCARRY(1))
DO WARNING
End DoDot:2
End DoDot:1
+17 ;
+18 ; Get Location
IF GMRCSRCH=2
Begin DoDot:1
+19 DO GETLOC(.GMRCARRY)
Begin DoDot:2
+20 IF '$DATA(GMRCARRY(1))
DO WARNING
End DoDot:2
End DoDot:1
+21 ;
+22 ; Get Procedure
IF GMRCSRCH=3
Begin DoDot:1
+23 DO GETPROC(.GMRCARRY)
Begin DoDot:2
+24 IF '$DATA(GMRCARRY)
DO WARNING
End DoDot:2
End DoDot:1
+25 IF GMRCEND=1
KILL GMRCEND
QUIT
+26 ; Get type or print
SET GMRCRPT=$$TYPERPT
if GMRCRPT=0
QUIT
+27 ; Break between sub-totals
IF GMRCRPT'=3
SET GMRCBRK=$$PAGEBRK
+28 IF GMRCBRK>1
QUIT
+29 ; Get Date
DO GETDATE
IF GMRCQUIT
QUIT
+30 IF '$DATA(GMRCDT2)
QUIT
+31 SET GMRCDT2=GMRCDT2+1
+32 ;
+33 ;
+34 ; Get search CPRS status
SET GMRCSTAT=$$STS^GMRCPC1
if 'GMRCSTAT
QUIT
+35 ;
+36 IF GMRCRPT=0
QUIT
+37 ;
+38 ; Get printer device
DO DEVICE
+39 ;
+40 ; At this point all user input has been collected
+41 ;
+42 IF $DATA(IO("Q"))
DO QUEUE
QUIT
+43 ;
+44 ; Go build ^TMP("GMRCRPT",$J) using user input variables &
+45 ; write report
+46 ;Report writer
DO PRINT^GMRCPSL2(GMRCSRCH,.GMRCARRY,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCRPT,GMRCBRK)
+47 KILL DIR,DIC,^TMP("GMRCRPT",$JOB)
+48 QUIT
+49 ;
CHECK(GMRCDAT) ;CHECK FREE TEXT INPUT
+1 NEW %DT,X,Y
+2 IF $EXTRACT("ALL DATES",1,$LENGTH(GMRCDAT))=$$UP^XLFSTR(GMRCDAT)
QUIT "ALL"
+3 SET %DT="E"
SET X=GMRCDAT
DO ^%DT
IF Y<1
QUIT 0
+4 QUIT +Y
+5 IF '$DATA(GMRCDT1)
QUIT
+6 IF GMRCDT1="ALL"
SET GMRCDT1=0000000
SET GMRCDT2=9999999
+7 QUIT
DEVICE ; device for printout of entries to group update
+1 NEW %ZIS,POP
+2 IF GMRCRPT=2
Begin DoDot:1
+3 WRITE !!,"You must configure your terminal so that it"
+4 WRITE " will support 132 character"
+5 WRITE !,"emulation and reply 132 to the right margin setting if"
+6 WRITE " using HOME"
+7 WRITE !,"as the device."
+8 WRITE !,""
End DoDot:1
+9 IF GMRCRPT=3
Begin DoDot:1
+10 WRITE !!,"OK, you have selected a TABLE output format."
+11 WRITE !,"You must use your personal computer's terminal emulation"
+12 WRITE !,"to capture the output:"
+13 WRITE !,""
+14 WRITE !," 1. Enter at the DEVICE: HOME// prompt "";250;99999999"
+15 WRITE !," and do not hit the enter key."
+16 WRITE !," 2. Open a capture file within your terminal emulation program."
+17 WRITE !," 3. Hit enter to start the down load."
+18 WRITE !," 4. Close the capture file when the output stops."
+19 WRITE !,""
End DoDot:1
RETRY ;
+1 SET %ZIS="MQ"
+2 DO ^%ZIS
+3 IF POP
SET GMRCEND=1
QUIT
+4 QUIT
+5 ;
GETDATE ;Get START and STOP dates
+1 ;GMRCDT1=Start date
+2 ;GMRCDT2=Stop date
+3 NEW DTOUT,DIR,DUOUT,DIRUT,X,Y
GETDATE1 ;
+1 SET DIR(0)="FA^1:45"
SET DIR("A")="List From Starting Date (ALL): "
+2 SET DIR("B")="T-30"
DO ^DIR
+3 IF $DATA(DUOUT)!($DATA(DTOUT))
SET GMRCQUIT=1
QUIT
+4 SET GMRCDT1=$$CHECK(X)
+5 IF 'GMRCDT1
IF GMRCDT1'="ALL"
GOTO GETDATE1
+6 IF GMRCDT1="ALL"
SET GMRCDT1=0
SET GMRCDT2=9999999
QUIT
+7 KILL DIR
+8 SET DIR(0)="DAO^::E"
SET DIR("A")="List To This Ending Date: "
DO ^DIR
+9 IF $DATA(DTOUT)!($DATA(DUOUT))
KILL GMRCDT1,GMRCDT2
QUIT
+10 IF +Y=0
WRITE "(NOW)"
SET GMRCDT2=$$DT^XLFDT
QUIT
+11 IF +Y<GMRCDT1
SET GMRCDT2=GMRCDT1
SET GMRCDT1=+Y
+12 if '$DATA(GMRCDT2)
SET GMRCDT2=+Y
+13 QUIT
+14 ;
+15 ; Get a Location
GETLOC(GMRCARRY) ;
+1 ; DBIA 10040 call DIC=44
+2 NEW DIC,DIR,DIRUT,DUOUT,DTOUT,X,Y,GMRCCNTR,GMRCQLOC
+3 SET GMRCCNTR=0
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
+5 SET DIR("A")="Enter 'YES' if you want all LOCATIONS"
+6 WRITE !,""
+7 DO ^DIR
+8 WRITE !,""
+9 IF Y=1
SET GMRCARRY(1)="ALL"
+10 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+11 SET DIR(0)="SA^L:LOCAL;R:REMOTE;B:BOTH LOCAL AND REMOTE LOCATIONS"
+12 SET DIR("A")=$SELECT($DATA(GMRCARRY):"All ",1:"")_"(L)ocal, (R)emote, or (B)oth Local and Remote Locations: "
+13 SET DIR("B")="Local"
+14 SET DIR("?")="^D HELP^GMRCPSL1"
+15 DO ^DIR
IF $DATA(DIRUT)
SET GMRCEND=1
QUIT
+16 SET GMRCARRY=Y
+17 if $DATA(GMRCARRY(1))
QUIT
+18 WRITE !
+19 IF "LB"[GMRCARRY
Begin DoDot:1
+20 SET DIC=44
SET DIC(0)="AEMQ"
SET DIC("A")="ENTER Local LOCATION: "
+21 FOR
DO ^DIC
if $DATA(DUOUT)!($DATA(DTOUT))!(Y<0)
QUIT
Begin DoDot:2
+22 SET GMRCCNTR=GMRCCNTR+1
+23 SET GMRCARRY(GMRCCNTR)=Y_"^"_44
End DoDot:2
End DoDot:1
+24 IF "B"[GMRCARRY
WRITE !
+25 IF "RB"[GMRCARRY
Begin DoDot:1
+26 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+27 SET DIR(0)="PO^4:EMQ"
+28 SET DIR("S")="I $$STA^XUAF4(+Y)=+$$STA^XUAF4(+Y)"
+29 SET DIR("A")="ENTER Remote LOCATION"
+30 SET DIR("?")="For this report, Institution file (#4) entries are considered Remote locations."
+31 FOR
DO ^DIR
if $DATA(DTOUT)
SET GMRCEND=1
if $DATA(DUOUT)
SET GMRCEND=1
if $DATA(DIRUT)
QUIT
Begin DoDot:2
+32 SET GMRCCNTR=GMRCCNTR+1
+33 SET GMRCARRY(GMRCCNTR)=Y_"^"_4
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
+36 ; Get a Procedure
GETPROC(GMRCARRY) ;
+1 NEW DIC,DIR,DIRUT,DUOUT,DTOUT,X,Y,GMRCCNTR,GMRCQPRC
+2 SET GMRCCNTR=0
+3 SET DIR(0)="Y"
SET DIR("B")="NO"
+4 SET DIR("A")="Enter 'YES' if you want all PROCEDURES"
+5 WRITE !,""
+6 DO ^DIR
+7 WRITE !,""
+8 IF Y=1
SET GMRCARRY(1)="ALL"
QUIT
+9 SET DIC=123.3
SET DIC(0)="AEMQ"
SET DIC("A")="ENTER PROCEDURE: "
+10 FOR
DO ^DIC
if $DATA(DUOUT)!($DATA(DTOUT))!(Y<0)
QUIT
Begin DoDot:1
+11 SET GMRCCNTR=GMRCCNTR+1
+12 SET GMRCARRY(GMRCCNTR)=Y
End DoDot:1
+13 QUIT
+14 ;
+15 ; Get a Provider name
GETPROV(GMRCARRY) ;
+1 ; DBIA 10060 call DIC=200
+2 NEW DIC,DIRUT,DUOUT,DTOUT,X,Y,GMRCCNTR,GMRCQPRV
+3 SET GMRCCNTR=0
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
+5 SET DIR("A")="Enter 'YES' if you want all PROVIDERS"
+6 WRITE !,""
+7 DO ^DIR
+8 WRITE !,""
+9 IF Y=1
SET GMRCARRY(1)="ALL"
+10 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+11 SET DIR(0)="SA^L:LOCAL;R:REMOTE;B:BOTH LOCAL AND REMOTE PROVIDERS"
+12 SET DIR("A")=$SELECT($DATA(GMRCARRY):"All ",1:"")_"(L)ocal, (R)emote, or (B)oth Local and Remote Providers: "
+13 SET DIR("B")="Local"
+14 SET DIR("?")="^D HELP^GMRCPSL1"
+15 DO ^DIR
IF $DATA(DIRUT)
SET GMRCEND=1
QUIT
+16 SET GMRCARRY=Y
+17 if $DATA(GMRCARRY(1))
QUIT
+18 WRITE !
+19 IF "LB"[GMRCARRY
Begin DoDot:1
+20 SET DIC=200
SET DIC(0)="AEMQ"
SET DIC("A")="ENTER Local PROVIDER: "
+21 FOR
DO ^DIC
if $DATA(DUOUT)!($DATA(DTOUT))!(Y<0)
QUIT
Begin DoDot:2
+22 SET GMRCCNTR=GMRCCNTR+1
+23 SET GMRCARRY(GMRCCNTR)=Y_"^"_200
End DoDot:2
End DoDot:1
+24 IF "B"[GMRCARRY
WRITE !
+25 IF "RB"[GMRCARRY
Begin DoDot:1
+26 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+27 SET DIR(0)="FO^2:40^D UP^GMRCA2 K:'$D(^GMR(123,""AIP"",X)) X"
+28 SET DIR("?")="^D HELPR^GMRCIR,HELPR^GMRCPSL1"
+29 SET DIR("A")="ENTER Remote PROVIDER"
+30 FOR
DO ^DIR
if $DATA(DTOUT)
SET GMRCEND=1
if $DATA(DUOUT)
SET GMRCEND=1
if $DATA(DIRUT)
QUIT
Begin DoDot:2
+31 DO UP^GMRCA2
SET Y=X
+32 SET GMRCCNTR=GMRCCNTR+1
+33 SET GMRCARRY(GMRCCNTR)=Y
End DoDot:2
End DoDot:1
+34 QUIT
HELP ; Help for location and provider prompts
+1 WRITE !!?3,"""Local"" refers to non-Inter-facility requests and Inter-"
+2 WRITE !?3,"facility requests originating locally."
+3 WRITE !?3,"""Remote"" only refers to Inter-facility requests originating"
+4 WRITE !?3,"at another site."
+5 QUIT
HELPR ; Help for remote provider prompt
+1 if $Y>(IOSL-4)
WRITE @IOF
+2 WRITE !!?3,"Enter the ENTIRE name in proper CASE, exactly as it"
+3 WRITE !?3,"appears in the above list (including any credentials)."
+4 WRITE !?3,"Use copy/paste to avoid typing errors."
+5 WRITE !?3,"NO partial matches are done."
+6 WRITE !
+7 QUIT
GETSRCH() ; What search criteria should report be in???
+1 NEW DIR,Y,X
+2 SET DIR("A",1)="Enter Search criteria:"
+3 SET DIR("A",2)=""
+4 SET DIR("A",3)=" 1 = Sending Provider"
+5 SET DIR("A",4)=" 2 = Location"
+6 SET DIR("A",5)=" 3 = Procedure"
+7 SET DIR("A",6)=""
+8 SET DIR("A")="Search criteria"
+9 SET DIR("B")=1
+10 SET DIR(0)="NO^1:3"
+11 DO ^DIR
+12 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT))
SET GMRCEND=1
+13 QUIT Y
+14 ;
PAGEBRK() ; Does user want page breaks between sub-totals?
+1 NEW DIR
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Display sort sequence & page breaks between sub-totals"
+4 SET DIR("B")="YES"
+5 DO ^DIR
IF $DATA(DIRUT)
QUIT 2
+6 QUIT +Y
TYPERPT() ; Get type of report to print
+1 NEW DIR
+2 SET DIR(0)="SO^1:80 column;2:132 column;3:Table Export"
+3 SET DIR("L",1)="Please select an output format from the following:"
+4 SET DIR("L",2)=""
+5 SET DIR("L",3)="1 - 80 column standard print [STANDARD]"
+6 SET DIR("L",4)="2 - 132 column standard print"
+7 SET DIR("L")="3 - Table without headers (export to another application)"
+8 SET DIR("B")=1
+9 DO ^DIR
IF $DATA(DIRUT)!(Y>3)
QUIT 0
+10 QUIT +Y
+11 ;
QUEUE ; send task for print and update
+1 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTSK
+2 SET ZTRTN="PRTTSK^GMRCPSL2"
SET ZTDESC="PRINT OF RECORDS FILE 123"
+3 SET ZTIO=ION
+4 SET ZTSAVE("GMRC*")=""
+5 DO ^%ZTLOAD
IF $GET(ZTSK)
WRITE !,"Task # ",ZTSK
+6 IF '$GET(ZTSK)
WRITE !,"Unable to queue report! Try again later."
+7 QUIT
WARNING ; Let user know that they did not enter any data.
+1 WRITE !!,"No search criteria was entered"
HANG 1
+2 SET GMRCEND=1
+3 QUIT
