GMRCP5 ;SLC/DCM,RJS - Print Consult form 513 (main entry) ;5/14/98 11:09
;;3.0;CONSULT/REQUEST TRACKING;**4,13,12**;Dec 27, 1997
;
TIUEN(GMRCIEN) ;Entry point for TIU to print 513
;
N GMRCPLEN,GMRCTASK,GMRCX
;
F GMRCX="OUTPUT","SF513" K ^TMP("GMRC",$J,GMRCX)
F GMRCX="GMRCTIU","RES" K ^TMP("GMRCR",$J,GMRCX)
;
Q:'+GMRCIEN D PRNT^GMRCP5A(GMRCIEN,1,0,"",0)
;
Q
;
GUI(ROOT,GMRCIFN) ;Entry point into routine for the GUI
;
; GMRCIFN = IFN of the record from file 123.
;
N GMRCCPY,GMRCPLEN,GMRCX
;
S GMRCPLEN=99998
S GMRCCPY="W"
F GMRCX="OUTPUT","SF513" K ^TMP("GMRC",$J,GMRCX)
F GMRCX="GMRCTIU","RES" K ^TMP("GMRCR",$J,GMRCX)
;
D PRNT^GMRCP5A(GMRCIFN,0,0,GMRCCPY,GMRCPLEN)
;
S ROOT=$NA(^TMP("GMRC",$J,"SF513"))
;
Q
;
EN(GMRCIFN,GMRCCPY,GMRCDEV,GMRCSTAT) ;Entry point into routine -GMRCIFN=IFN from file 123
;GMRCIFN = IFN of the record from file 123.
;
N GMRCPLEN,GMRCTASK
;
S GMRCSTAT=0
F GMRCX="OUTPUT","SF513" K ^TMP("GMRC",$J,GMRCX)
F GMRCX="GMRCTIU","RES" K ^TMP("GMRCR",$J,GMRCX)
I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
;
I $D(GMRCDEV) D Q
.S GMRCTASK=$$QUEUE(GMRCIFN,GMRCCPY,GMRCDEV)
.I GMRCTASK S GMRCSTAT="0^Queued as task # "_GMRCTASK
.E S GMRCSTAT="-1^Not Queued"
;
I '$D(GMRCCPY) S GMRCCPY=$$CCOPY Q:(GMRCCPY=U)
Q:'$$DEVICE
;
I $D(IO("Q")) D Q
.S GMRCTASK=$$QUEUE(GMRCIFN,GMRCCPY)
.I GMRCTASK S GMRCSTAT="0^Queued as task # "_GMRCTASK
.E S GMRCSTAT="-1^Not Queued"
.W " ",$P(GMRCSTAT,U,2) H 2
;
D PRNT^GMRCP5A(GMRCIFN,0,0,GMRCCPY,0)
;
Q
;
SEL ;Select the consult/request to print
K GMRCQUT,DTOUT,DIRUOUT,GMRCSEL
I '$D(^TMP("GMRCR",$J,"CS","AD")) W $C(7),!,"No Orders To Print!",! S GMRCQUT=1 Q
I $D(GMRC("NMBR")) S GMRCSEL=GMRC("NMBR") I $S(GMRCSEL<1:1,GMRCSEL>BLK:1,1:0) K GMRCSEL D AGAIN^GMRCSLMV(GMRC("NMBR"))
I '$O(^TMP("GMRCR",$J,"CS","AD")),BLK=1 S GMRCSEL=BLK
I $S('$D(GMRCSEL):1,'$L(GMRCSEL):1,1:0) D SEL^GMRCA2 I $D(DTOUT)!($D(DIRUOUT)) S GMRCQUT=1 Q
I $S(GMRCSEL<1:1,GMRCSEL>BLK:1,GMRCSEL="":1,1:0) W $C(7),!,"Select A Number In The Range 1 To "_BLK G SEL
I GMRCSEL="" S GMRCQUT=1 Q
S GMRCND=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0))
I $S('$L(GMRCND):1,1:0) S GMRCMSG="The Consult to print is not defined in the list to select from!" D EXAC^GMRCADC(GMRCMSG) S GMRCQUT=1 Q
Q
;
QUEUE(GMRCIFN,GMRCCPY,GMRCDEV) ;
;
N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTRTN
N ZTSAVE,ZTSK,ZTUCI
;
S ZTDESC="CONSULT/REQUEST PACKAGE PRINT FORM 513"
;
I $D(GMRCDEV) S ZTIO=GMRCDEV
E S ZTIO=ION
;
S ZTDTH=$H
S ZTRTN="PRNT^GMRCP5A("_(+GMRCIFN)_",0,1,"""_(GMRCCPY)_""",0)"
D ^%ZTLOAD
D:'$D(GMRCDEV) ^%ZISC
;
Q $G(ZTSK)
;
CCOPY() ; Determine if this is a "Chart" copy or a "Working" copy
;
N GMRCSTAT,GMRCX,GMRCDEF
;
; GMRCDEF=1 CHART
; GMRCDEF=0 WORKING
;
S GMRCSTAT=$G(^GMR(123,GMRCIFN,0)) Q:'$L(GMRCSTAT) ""
S GMRCSTAT=$P(GMRCSTAT,U,12)
S GMRCDEF=(GMRCSTAT=2)
;
F D Q:$L(GMRCX)
.;
.W !,$$COPY(GMRCDEF)_" Copy (Y/N)? Y//"
.R GMRCX:DTIME E S GMRCX=U
.Q:(GMRCX[U)
.;
.S:'$L(GMRCX) GMRCX="Y"
.S GMRCX=$E(GMRCX,1)
.S GMRCX=$TR(GMRCX,"ynwc","YNWC")
.;
.I '("YNWC"[GMRCX) S GMRCX="?"
.;
.I GMRCX["?" D S GMRCX="" Q
..W !
..W !," Type 'Y' To Print A '"_$$COPY(GMRCDEF)_"' Copy Of The Form 513,"
..W !," or Type 'N' To Print A '"_$$COPY('GMRCDEF)_"' Copy Of The Form 513,"
..W !," or Type 'C' To Print A 'Chart' Copy Of The Form 513,"
..W !," or Type 'W' To Print A 'Working' Copy Of The Form 513."
..W !
;
I (GMRCX="Y") Q $E($$COPY(GMRCDEF),1)
I (GMRCX="N") Q $E($$COPY('GMRCDEF),1)
Q GMRCX
;
COPY(X) Q:X "Chart" Q "Working"
;
DEVICE() ;Ask output device / set up output device print parameters
N POP,%ZIS,%IS
S POP=0,%ZIS="MQ" D ^%ZIS
Q $S(POP:0,IO="":0,1:1)
;
;
SETUP ;
;
N LINE,%ZIS,%IS,POP,IOP
;
W !!,"Print consults printer setup page.",!
K IOP S %ZIS="MQ" D ^%ZIS Q:POP
;
I $D(IO("Q")) D Q
.;
.N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTRTN
.N ZTSAVE,ZTSK,ZTUCI
.;
.S ZTDESC="CONSULT/REQUEST PACKAGE PRINTER TEST PAGE"
.S ZTIO=ION,ZTDTH=$H,ZTRTN="SETPRNT^GMRCP5"
.S ZTSAVE("DUZ")=""
.;
.D ^%ZTLOAD,^%ZISC
.;
.I ZTSK W !!,"Queued as task #",ZTSK
.E W !!," not queued."
;
SETPRNT ;
I $D(ZTQUEUED) S ZTREQ="@"
N LINE
U IO D
.W @IOF,1
.W !,2
.W !,3," *******CONSULTS PRINT SETUP PAGE*******"
.W !,4
.W !,5,?4,$$REPEAT^XLFSTR("*",70)
.W !,6,?4," Printed by: ",$$GET1^DIQ(200,+$G(DUZ),.01)," on "
.W $$FMTE^XLFDT($$NOW^XLFDT)
.W !,7,?4,$$REPEAT^XLFSTR("*",70)
.W !,8
.W !,9," Print Device: ",$G(ION)
.W !,10," Terminal Type: ",$G(IOST)
.W !,11," Defined lines per page for this device: ",+$G(IOSL)
.W !,12," Defined margin width for this device: ",+$G(IOM)
.W !,13
.W !,14," There should be numbers listed down the lefthand side of"
.W !,15," this page all the way to the bottom. The number at the"
.W !,16," bottom of the page is the number of lines the PRINTER"
.W !,17," thinks there are on a page. The COMPUTER thinks there are ",+$G(IOSL)
.W !,18," lines on a page. The number at the bottom of the page needs to"
.W !,19," be EQUAL to ",+$G(IOSL)," so the consults program can print"
.W !,20," without running off the end of the page. If the number at the"
.W !,21," bottom of the page is NOT EQUAL to ",+$G(IOSL)," then have"
.W !,22," someone in IRM adjust the"
.W !,23
.W !,24," DEVICE file (file 3.5) *PAGE LENGTH field (#11)"
.W !,25," for device: ",$G(ION)
.W !,26
.W !,27," and the TERMINAL TYPE file (file 3.2) PAGE LENGTH field (#3)"
.W !,28," for terminal type: ",$G(IOST)
.W !,29
.W !,30," to be a value EQUAL to the number at the bottom of the page."
.F LINE=31:1:100 W !,LINE
U IO(0) D ^%ZISC
;
I $G(ZTSK) D KILL^%ZTLOAD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCP5 5884 printed Sep 23, 2025@19:22:28 Page 2
GMRCP5 ;SLC/DCM,RJS - Print Consult form 513 (main entry) ;5/14/98 11:09
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4,13,12**;Dec 27, 1997
+2 ;
TIUEN(GMRCIEN) ;Entry point for TIU to print 513
+1 ;
+2 NEW GMRCPLEN,GMRCTASK,GMRCX
+3 ;
+4 FOR GMRCX="OUTPUT","SF513"
KILL ^TMP("GMRC",$JOB,GMRCX)
+5 FOR GMRCX="GMRCTIU","RES"
KILL ^TMP("GMRCR",$JOB,GMRCX)
+6 ;
+7 if '+GMRCIEN
QUIT
DO PRNT^GMRCP5A(GMRCIEN,1,0,"",0)
+8 ;
+9 QUIT
+10 ;
GUI(ROOT,GMRCIFN) ;Entry point into routine for the GUI
+1 ;
+2 ; GMRCIFN = IFN of the record from file 123.
+3 ;
+4 NEW GMRCCPY,GMRCPLEN,GMRCX
+5 ;
+6 SET GMRCPLEN=99998
+7 SET GMRCCPY="W"
+8 FOR GMRCX="OUTPUT","SF513"
KILL ^TMP("GMRC",$JOB,GMRCX)
+9 FOR GMRCX="GMRCTIU","RES"
KILL ^TMP("GMRCR",$JOB,GMRCX)
+10 ;
+11 DO PRNT^GMRCP5A(GMRCIFN,0,0,GMRCCPY,GMRCPLEN)
+12 ;
+13 SET ROOT=$NAME(^TMP("GMRC",$JOB,"SF513"))
+14 ;
+15 QUIT
+16 ;
EN(GMRCIFN,GMRCCPY,GMRCDEV,GMRCSTAT) ;Entry point into routine -GMRCIFN=IFN from file 123
+1 ;GMRCIFN = IFN of the record from file 123.
+2 ;
+3 NEW GMRCPLEN,GMRCTASK
+4 ;
+5 SET GMRCSTAT=0
+6 FOR GMRCX="OUTPUT","SF513"
KILL ^TMP("GMRC",$JOB,GMRCX)
+7 FOR GMRCX="GMRCTIU","RES"
KILL ^TMP("GMRCR",$JOB,GMRCX)
+8 IF $DATA(IOTM)
IF $DATA(IOBM)
IF $DATA(IOSTBM)
DO FULL^VALM1
+9 ;
+10 IF $DATA(GMRCDEV)
Begin DoDot:1
+11 SET GMRCTASK=$$QUEUE(GMRCIFN,GMRCCPY,GMRCDEV)
+12 IF GMRCTASK
SET GMRCSTAT="0^Queued as task # "_GMRCTASK
+13 IF '$TEST
SET GMRCSTAT="-1^Not Queued"
End DoDot:1
QUIT
+14 ;
+15 IF '$DATA(GMRCCPY)
SET GMRCCPY=$$CCOPY
if (GMRCCPY=U)
QUIT
+16 if '$$DEVICE
QUIT
+17 ;
+18 IF $DATA(IO("Q"))
Begin DoDot:1
+19 SET GMRCTASK=$$QUEUE(GMRCIFN,GMRCCPY)
+20 IF GMRCTASK
SET GMRCSTAT="0^Queued as task # "_GMRCTASK
+21 IF '$TEST
SET GMRCSTAT="-1^Not Queued"
+22 WRITE " ",$PIECE(GMRCSTAT,U,2)
HANG 2
End DoDot:1
QUIT
+23 ;
+24 DO PRNT^GMRCP5A(GMRCIFN,0,0,GMRCCPY,0)
+25 ;
+26 QUIT
+27 ;
SEL ;Select the consult/request to print
+1 KILL GMRCQUT,DTOUT,DIRUOUT,GMRCSEL
+2 IF '$DATA(^TMP("GMRCR",$JOB,"CS","AD"))
WRITE $CHAR(7),!,"No Orders To Print!",!
SET GMRCQUT=1
QUIT
+3 IF $DATA(GMRC("NMBR"))
SET GMRCSEL=GMRC("NMBR")
IF $SELECT(GMRCSEL<1:1,GMRCSEL>BLK:1,1:0)
KILL GMRCSEL
DO AGAIN^GMRCSLMV(GMRC("NMBR"))
+4 IF '$ORDER(^TMP("GMRCR",$JOB,"CS","AD"))
IF BLK=1
SET GMRCSEL=BLK
+5 IF $SELECT('$DATA(GMRCSEL):1,'$LENGTH(GMRCSEL):1,1:0)
DO SEL^GMRCA2
IF $DATA(DTOUT)!($DATA(DIRUOUT))
SET GMRCQUT=1
QUIT
+6 IF $SELECT(GMRCSEL<1:1,GMRCSEL>BLK:1,GMRCSEL="":1,1:0)
WRITE $CHAR(7),!,"Select A Number In The Range 1 To "_BLK
GOTO SEL
+7 IF GMRCSEL=""
SET GMRCQUT=1
QUIT
+8 SET GMRCND=$ORDER(^TMP("GMRCR",$JOB,"CS","AD",GMRCSEL,GMRCSEL,0))
+9 IF $SELECT('$LENGTH(GMRCND):1,1:0)
SET GMRCMSG="The Consult to print is not defined in the list to select from!"
DO EXAC^GMRCADC(GMRCMSG)
SET GMRCQUT=1
QUIT
+10 QUIT
+11 ;
QUEUE(GMRCIFN,GMRCCPY,GMRCDEV) ;
+1 ;
+2 NEW ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTRTN
+3 NEW ZTSAVE,ZTSK,ZTUCI
+4 ;
+5 SET ZTDESC="CONSULT/REQUEST PACKAGE PRINT FORM 513"
+6 ;
+7 IF $DATA(GMRCDEV)
SET ZTIO=GMRCDEV
+8 IF '$TEST
SET ZTIO=ION
+9 ;
+10 SET ZTDTH=$HOROLOG
+11 SET ZTRTN="PRNT^GMRCP5A("_(+GMRCIFN)_",0,1,"""_(GMRCCPY)_""",0)"
+12 DO ^%ZTLOAD
+13 if '$DATA(GMRCDEV)
DO ^%ZISC
+14 ;
+15 QUIT $GET(ZTSK)
+16 ;
CCOPY() ; Determine if this is a "Chart" copy or a "Working" copy
+1 ;
+2 NEW GMRCSTAT,GMRCX,GMRCDEF
+3 ;
+4 ; GMRCDEF=1 CHART
+5 ; GMRCDEF=0 WORKING
+6 ;
+7 SET GMRCSTAT=$GET(^GMR(123,GMRCIFN,0))
if '$LENGTH(GMRCSTAT)
QUIT ""
+8 SET GMRCSTAT=$PIECE(GMRCSTAT,U,12)
+9 SET GMRCDEF=(GMRCSTAT=2)
+10 ;
+11 FOR
Begin DoDot:1
+12 ;
+13 WRITE !,$$COPY(GMRCDEF)_" Copy (Y/N)? Y//"
+14 READ GMRCX:DTIME
IF '$TEST
SET GMRCX=U
+15 if (GMRCX[U)
QUIT
+16 ;
+17 if '$LENGTH(GMRCX)
SET GMRCX="Y"
+18 SET GMRCX=$EXTRACT(GMRCX,1)
+19 SET GMRCX=$TRANSLATE(GMRCX,"ynwc","YNWC")
+20 ;
+21 IF '("YNWC"[GMRCX)
SET GMRCX="?"
+22 ;
+23 IF GMRCX["?"
Begin DoDot:2
+24 WRITE !
+25 WRITE !," Type 'Y' To Print A '"_$$COPY(GMRCDEF)_"' Copy Of The Form 513,"
+26 WRITE !," or Type 'N' To Print A '"_$$COPY('GMRCDEF)_"' Copy Of The Form 513,"
+27 WRITE !," or Type 'C' To Print A 'Chart' Copy Of The Form 513,"
+28 WRITE !," or Type 'W' To Print A 'Working' Copy Of The Form 513."
+29 WRITE !
End DoDot:2
SET GMRCX=""
QUIT
End DoDot:1
if $LENGTH(GMRCX)
QUIT
+30 ;
+31 IF (GMRCX="Y")
QUIT $EXTRACT($$COPY(GMRCDEF),1)
+32 IF (GMRCX="N")
QUIT $EXTRACT($$COPY('GMRCDEF),1)
+33 QUIT GMRCX
+34 ;
COPY(X) if X
QUIT "Chart"
QUIT "Working"
+1 ;
DEVICE() ;Ask output device / set up output device print parameters
+1 NEW POP,%ZIS,%IS
+2 SET POP=0
SET %ZIS="MQ"
DO ^%ZIS
+3 QUIT $SELECT(POP:0,IO="":0,1:1)
+4 ;
+5 ;
SETUP ;
+1 ;
+2 NEW LINE,%ZIS,%IS,POP,IOP
+3 ;
+4 WRITE !!,"Print consults printer setup page.",!
+5 KILL IOP
SET %ZIS="MQ"
DO ^%ZIS
if POP
QUIT
+6 ;
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 ;
+9 NEW ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTRTN
+10 NEW ZTSAVE,ZTSK,ZTUCI
+11 ;
+12 SET ZTDESC="CONSULT/REQUEST PACKAGE PRINTER TEST PAGE"
+13 SET ZTIO=ION
SET ZTDTH=$HOROLOG
SET ZTRTN="SETPRNT^GMRCP5"
+14 SET ZTSAVE("DUZ")=""
+15 ;
+16 DO ^%ZTLOAD
DO ^%ZISC
+17 ;
+18 IF ZTSK
WRITE !!,"Queued as task #",ZTSK
+19 IF '$TEST
WRITE !!," not queued."
End DoDot:1
QUIT
+20 ;
SETPRNT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 NEW LINE
+3 USE IO
Begin DoDot:1
+4 WRITE @IOF,1
+5 WRITE !,2
+6 WRITE !,3," *******CONSULTS PRINT SETUP PAGE*******"
+7 WRITE !,4
+8 WRITE !,5,?4,$$REPEAT^XLFSTR("*",70)
+9 WRITE !,6,?4," Printed by: ",$$GET1^DIQ(200,+$GET(DUZ),.01)," on "
+10 WRITE $$FMTE^XLFDT($$NOW^XLFDT)
+11 WRITE !,7,?4,$$REPEAT^XLFSTR("*",70)
+12 WRITE !,8
+13 WRITE !,9," Print Device: ",$GET(ION)
+14 WRITE !,10," Terminal Type: ",$GET(IOST)
+15 WRITE !,11," Defined lines per page for this device: ",+$GET(IOSL)
+16 WRITE !,12," Defined margin width for this device: ",+$GET(IOM)
+17 WRITE !,13
+18 WRITE !,14," There should be numbers listed down the lefthand side of"
+19 WRITE !,15," this page all the way to the bottom. The number at the"
+20 WRITE !,16," bottom of the page is the number of lines the PRINTER"
+21 WRITE !,17," thinks there are on a page. The COMPUTER thinks there are ",+$GET(IOSL)
+22 WRITE !,18," lines on a page. The number at the bottom of the page needs to"
+23 WRITE !,19," be EQUAL to ",+$GET(IOSL)," so the consults program can print"
+24 WRITE !,20," without running off the end of the page. If the number at the"
+25 WRITE !,21," bottom of the page is NOT EQUAL to ",+$GET(IOSL)," then have"
+26 WRITE !,22," someone in IRM adjust the"
+27 WRITE !,23
+28 WRITE !,24," DEVICE file (file 3.5) *PAGE LENGTH field (#11)"
+29 WRITE !,25," for device: ",$GET(ION)
+30 WRITE !,26
+31 WRITE !,27," and the TERMINAL TYPE file (file 3.2) PAGE LENGTH field (#3)"
+32 WRITE !,28," for terminal type: ",$GET(IOST)
+33 WRITE !,29
+34 WRITE !,30," to be a value EQUAL to the number at the bottom of the page."
+35 FOR LINE=31:1:100
WRITE !,LINE
End DoDot:1
+36 USE IO(0)
DO ^%ZISC
+37 ;
+38 IF $GET(ZTSK)
DO KILL^%ZTLOAD
+39 ;
+40 QUIT
