Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCP5

GMRCP5.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. TIUEN(GMRCIEN) ;Entry point for TIU to print 513
  1.  ;
  1.  N GMRCPLEN,GMRCTASK,GMRCX
  1.  ;
  1.  F GMRCX="OUTPUT","SF513" K ^TMP("GMRC",$J,GMRCX)
  1.  F GMRCX="GMRCTIU","RES" K ^TMP("GMRCR",$J,GMRCX)
  1.  ;
  1.  Q:'+GMRCIEN  D PRNT^GMRCP5A(GMRCIEN,1,0,"",0)
  1.  ;
  1.  Q
  1.  ;
  1. GUI(ROOT,GMRCIFN) ;Entry point into routine for the GUI
  1.  ;
  1.  ; GMRCIFN = IFN of the record from file 123.
  1.  ;
  1.  N GMRCCPY,GMRCPLEN,GMRCX
  1.  ;
  1.  S GMRCPLEN=99998
  1.  S GMRCCPY="W"
  1.  F GMRCX="OUTPUT","SF513" K ^TMP("GMRC",$J,GMRCX)
  1.  F GMRCX="GMRCTIU","RES" K ^TMP("GMRCR",$J,GMRCX)
  1.  ;
  1.  D PRNT^GMRCP5A(GMRCIFN,0,0,GMRCCPY,GMRCPLEN)
  1.  ;
  1.  S ROOT=$NA(^TMP("GMRC",$J,"SF513"))
  1.  ;
  1.  Q
  1.  ;
  1. EN(GMRCIFN,GMRCCPY,GMRCDEV,GMRCSTAT) ;Entry point into routine -GMRCIFN=IFN from file 123
  1.  ;GMRCIFN = IFN of the record from file 123.
  1.  ;
  1.  N GMRCPLEN,GMRCTASK
  1.  ;
  1.  S GMRCSTAT=0
  1.  F GMRCX="OUTPUT","SF513" K ^TMP("GMRC",$J,GMRCX)
  1.  F GMRCX="GMRCTIU","RES" K ^TMP("GMRCR",$J,GMRCX)
  1.  I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
  1.  ;
  1.  I $D(GMRCDEV) D  Q
  1.  .S GMRCTASK=$$QUEUE(GMRCIFN,GMRCCPY,GMRCDEV)
  1.  .I GMRCTASK S GMRCSTAT="0^Queued as task # "_GMRCTASK
  1.  .E  S GMRCSTAT="-1^Not Queued"
  1.  ;
  1.  I '$D(GMRCCPY) S GMRCCPY=$$CCOPY Q:(GMRCCPY=U)
  1.  Q:'$$DEVICE
  1.  ;
  1.  I $D(IO("Q")) D  Q
  1.  .S GMRCTASK=$$QUEUE(GMRCIFN,GMRCCPY)
  1.  .I GMRCTASK S GMRCSTAT="0^Queued as task # "_GMRCTASK
  1.  .E  S GMRCSTAT="-1^Not Queued"
  1.  .W "  ",$P(GMRCSTAT,U,2) H 2
  1.  ;
  1.  D PRNT^GMRCP5A(GMRCIFN,0,0,GMRCCPY,0)
  1.  ;
  1.  Q
  1.  ;
  1. SEL ;Select the consult/request to print
  1.  K GMRCQUT,DTOUT,DIRUOUT,GMRCSEL
  1.  I '$D(^TMP("GMRCR",$J,"CS","AD")) W $C(7),!,"No Orders To Print!",! S GMRCQUT=1 Q
  1.  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"))
  1.  I '$O(^TMP("GMRCR",$J,"CS","AD")),BLK=1 S GMRCSEL=BLK
  1.  I $S('$D(GMRCSEL):1,'$L(GMRCSEL):1,1:0) D SEL^GMRCA2 I $D(DTOUT)!($D(DIRUOUT)) S GMRCQUT=1 Q
  1.  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
  1.  I GMRCSEL="" S GMRCQUT=1 Q
  1.  S GMRCND=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0))
  1.  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
  1.  Q
  1.  ;
  1. QUEUE(GMRCIFN,GMRCCPY,GMRCDEV) ;
  1.  ;
  1.  N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTRTN
  1.  N ZTSAVE,ZTSK,ZTUCI
  1.  ;
  1.  S ZTDESC="CONSULT/REQUEST PACKAGE PRINT FORM 513"
  1.  ;
  1.  I $D(GMRCDEV) S ZTIO=GMRCDEV
  1.  E  S ZTIO=ION
  1.  ;
  1.  S ZTDTH=$H
  1.  S ZTRTN="PRNT^GMRCP5A("_(+GMRCIFN)_",0,1,"""_(GMRCCPY)_""",0)"
  1.  D ^%ZTLOAD
  1.  D:'$D(GMRCDEV) ^%ZISC
  1.  ;
  1.  Q $G(ZTSK)
  1.  ;
  1. CCOPY() ; Determine if this is a "Chart" copy or a "Working" copy
  1.  ;
  1.  N GMRCSTAT,GMRCX,GMRCDEF
  1.  ;
  1.  ;  GMRCDEF=1   CHART
  1.  ;  GMRCDEF=0   WORKING
  1.  ;
  1.  S GMRCSTAT=$G(^GMR(123,GMRCIFN,0)) Q:'$L(GMRCSTAT) ""
  1.  S GMRCSTAT=$P(GMRCSTAT,U,12)
  1.  S GMRCDEF=(GMRCSTAT=2)
  1.  ;
  1.  F  D  Q:$L(GMRCX)
  1.  .;
  1.  .W !,$$COPY(GMRCDEF)_" Copy (Y/N)? Y//"
  1.  .R GMRCX:DTIME E  S GMRCX=U
  1.  .Q:(GMRCX[U)
  1.  .;
  1.  .S:'$L(GMRCX) GMRCX="Y"
  1.  .S GMRCX=$E(GMRCX,1)
  1.  .S GMRCX=$TR(GMRCX,"ynwc","YNWC")
  1.  .;
  1.  .I '("YNWC"[GMRCX) S GMRCX="?"
  1.  .;
  1.  .I GMRCX["?" D  S GMRCX="" Q
  1.  ..W !
  1.  ..W !,"    Type 'Y' To Print A '"_$$COPY(GMRCDEF)_"' Copy Of The Form 513,"
  1.  ..W !," or Type 'N' To Print A '"_$$COPY('GMRCDEF)_"' Copy Of The Form 513,"
  1.  ..W !," or Type 'C' To Print A 'Chart' Copy Of The Form 513,"
  1.  ..W !," or Type 'W' To Print A 'Working' Copy Of The Form 513."
  1.  ..W !
  1.  ;
  1.  I (GMRCX="Y") Q $E($$COPY(GMRCDEF),1)
  1.  I (GMRCX="N") Q $E($$COPY('GMRCDEF),1)
  1.  Q GMRCX
  1.  ;
  1. COPY(X) Q:X "Chart" Q "Working"
  1.  ;
  1. DEVICE() ;Ask output device / set up output device print parameters
  1.  N POP,%ZIS,%IS
  1.  S POP=0,%ZIS="MQ" D ^%ZIS
  1.  Q $S(POP:0,IO="":0,1:1)
  1.  ;
  1.  ;
  1. SETUP ;
  1.  ;
  1.  N LINE,%ZIS,%IS,POP,IOP
  1.  ;
  1.  W !!,"Print consults printer setup page.",!
  1.  K IOP S %ZIS="MQ" D ^%ZIS Q:POP
  1.  ;
  1.  I $D(IO("Q")) D  Q
  1.  .;
  1.  .N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTPAR,ZTPRE,ZTPRI,ZTRTN
  1.  .N ZTSAVE,ZTSK,ZTUCI
  1.  .;
  1.  .S ZTDESC="CONSULT/REQUEST PACKAGE PRINTER TEST PAGE"
  1.  .S ZTIO=ION,ZTDTH=$H,ZTRTN="SETPRNT^GMRCP5"
  1.  .S ZTSAVE("DUZ")=""
  1.  .;
  1.  .D ^%ZTLOAD,^%ZISC
  1.  .;
  1.  .I ZTSK W !!,"Queued as task #",ZTSK
  1.  .E  W !!,"  not queued."
  1.  ;
  1. SETPRNT ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  N LINE
  1.  U IO D
  1.  .W @IOF,1
  1.  .W !,2
  1.  .W !,3,"           *******CONSULTS PRINT SETUP PAGE*******"
  1.  .W !,4
  1.  .W !,5,?4,$$REPEAT^XLFSTR("*",70)
  1.  .W !,6,?4," Printed by: ",$$GET1^DIQ(200,+$G(DUZ),.01)," on "
  1.  .W $$FMTE^XLFDT($$NOW^XLFDT)
  1.  .W !,7,?4,$$REPEAT^XLFSTR("*",70)
  1.  .W !,8
  1.  .W !,9,"     Print Device: ",$G(ION)
  1.  .W !,10,"    Terminal Type: ",$G(IOST)
  1.  .W !,11,"    Defined lines per page for this device: ",+$G(IOSL)
  1.  .W !,12,"    Defined margin width for this device: ",+$G(IOM)
  1.  .W !,13
  1.  .W !,14," There should be numbers listed down the lefthand side of"
  1.  .W !,15," this page all the way to the bottom. The number at the"
  1.  .W !,16," bottom of the page is the number of lines the PRINTER"
  1.  .W !,17," thinks there are on a page. The COMPUTER thinks there are ",+$G(IOSL)
  1.  .W !,18," lines on a page. The number at the bottom of the page needs to"
  1.  .W !,19," be EQUAL to ",+$G(IOSL)," so the consults program can print"
  1.  .W !,20," without running off the end of the page. If the number at the"
  1.  .W !,21," bottom of the page is NOT EQUAL to ",+$G(IOSL)," then have"
  1.  .W !,22," someone in IRM adjust the"
  1.  .W !,23
  1.  .W !,24," DEVICE file (file 3.5) *PAGE LENGTH field (#11)"
  1.  .W !,25,"           for device: ",$G(ION)
  1.  .W !,26
  1.  .W !,27," and the TERMINAL TYPE file (file 3.2) PAGE LENGTH field (#3)"
  1.  .W !,28,"    for terminal type: ",$G(IOST)
  1.  .W !,29
  1.  .W !,30," to be a value EQUAL to the number at the bottom of the page."
  1.  .F LINE=31:1:100 W !,LINE
  1.  U IO(0) D ^%ZISC
  1.  ;
  1.  I $G(ZTSK) D KILL^%ZTLOAD
  1.  ;
  1.  Q