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

GMRCPC.m

Go to the documentation of this file.
  1. GMRCPC ;SLC/DCM,dee,MA - List Manager Routine: Collect and display consults by service and status ;4/18/01 10:29
  1. ;;3.0;CONSULT/REQUEST TRACKING;**1,7,21,23,22**;DEC 27, 1997
  1. ; Patch #21 added clean-up KILL for ^TMP("GMRCTOT",$J)
  1. ; Patch #23 add a KILL for GMRCSVNM
  1. EN ;GMRC List Manager Routine -- main entry point for GMRC PENDING CONSULTS
  1. K GMRCSVC,GMRCSVCP
  1. I $D(GMRCEACT),$L(GMRCEACT) D I '$D(^GMR(123.5,$G(GMRCSVC),0)) D EXIT Q
  1. .S GMRCSVCP=GMRCEACT
  1. .S GMRCSVC=$O(^GMR(123.5,"B",GMRCSVCP,0))
  1. .Q:'$D(^GMR(123.5,$G(GMRCSVC),0))
  1. .;Build service array
  1. .S GMRCDG=GMRCSVC
  1. .D SERV1^GMRCASV
  1. .S GMRCDT1="ALL"
  1. .S GMRCDT2=0
  1. .D LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
  1. ;If no service ask for one
  1. I '$L($G(GMRCSVC)) D EN^GMRCSTLM I $D(GMRCQUT) D EXIT Q
  1. ;Quit if no array of services
  1. I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 D EXIT Q
  1. ;
  1. D EN^VALM("GMRC PENDING CONSULTS")
  1. ;
  1. HDR ; -- header code
  1. Q:$D(GMRCQUT)!'$D(GMRCCT)
  1. S VALMHDR(1)="To Service: "_GMRCHEAD
  1. S VALMHDR(2)="From: "_$G(GMRCEDT1)_" To: "_$G(GMRCEDT2)
  1. I $G(GMRCCTRL)=1 S VALMCAP=" "_VALMCAP
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. ;This entry is not used ENORLM^GMRCSTLM is used instead.
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K CNT,CTRLCOL,GMRCCT,GMRCQUT,GMRCSVC,GMRCSVCP,VALMHDR,GMRCCOMP
  1. K GMRCEDT1,GMRCEDT2,GMRCSVNM
  1. K GMRCHEAD,GMRCCTRL,GMRCSTAT,GMRCARRN
  1. K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J),^TMP("GMRCR",$J,"CP"),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J)
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. CWIDTH(GMRCCTRL) ;Prints a message about how wide the report is.
  1. N WIDTH
  1. S WIDTH=92
  1. I GMRCCTRL#100\10 D
  1. .I GMRCCTRL#100\10=1 S WIDTH=WIDTH+5
  1. .E S WIDTH=WIDTH+10
  1. I GMRCCTRL#1000\100 S WIDTH=WIDTH-6
  1. Q WIDTH
  1. ;
  1. PWIDTH(GMRCCTRL) ;Prints a message about how wide the report is.
  1. W !!,"This print out is "_$$CWIDTH(GMRCCTRL)_" columns wide."
  1. Q
  1. ;
  1. PRNTONLY(GMRCCTRL) ;Option to just send the report to a device.
  1. N GMRCQUT,RETURN,GMRCDG,GMRCSTAT,VALMBCK
  1. N GMRCDT1,GMRCDT2,GMRCEDT1,GMRCEDT2
  1. ;Get the statuses
  1. S GMRCSTAT=$$STS^GMRCPC1
  1. I $D(GMRCQUT) D EXIT Q
  1. ;Get the service and date range.
  1. D EN^GMRCSTLM
  1. I $D(GMRCQUT) D EXIT Q
  1. ;Quit if no array of services
  1. I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 D EXIT Q
  1. I '($D(GMRCCTRL)#2) S GMRCCTRL=0 ;default to just the list
  1. D PWIDTH(GMRCCTRL)
  1. ;Get the device
  1. D PRNTASK^GMRCSTU
  1. I $D(GMRCQUT) D EXIT Q
  1. ;Save some things if the report is queued
  1. I $D(IO("Q")) D
  1. .S ZTSAVE("GMRCSTAT")=""
  1. .S ZTSAVE("GMRCCTRL")=""
  1. ;Create the report if not queued
  1. E D ENOR^GMRCSTLM(.RETURN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCCTRL,"CP")
  1. ;Print the report
  1. D PRNTIT^GMRCSTU("CP","PRNTQ^GMRCPC","CONSULT/REQUEST PACKAGE PRINT SERVICE CONSULTS BY STATUS FROM OPTION")
  1. D EXIT
  1. Q
  1. ;
  1. PRNTQ ;Print Queued report from ^TMP global then kill off ^TMP & ^XTMP
  1. ;Create the report
  1. N RETURN,INDEX
  1. D ENOR^GMRCSTLM(.RETURN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCCTRL,"CP")
  1. U IO
  1. S INDEX=""
  1. F S INDEX=$O(^TMP("GMRCR",$J,TMPNAME,INDEX)) Q:INDEX="" W ^TMP("GMRCR",$J,TMPNAME,INDEX,0),!
  1. K ^TMP("GMRCR",$J,TMPNAME),^XTMP("GMRCR",J,DOLLARH,"PRINT"),J,DOLLARH
  1. D ^%ZISC
  1. D EXIT
  1. Q
  1. ;