source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCPC.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1GMRCPC ;SLC/DCM,dee,MA - List Manager Routine: Collect and display consults by service and status ;4/18/01 10:29
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,7,21,23,22**;DEC 27, 1997
3 ; Patch #21 added clean-up KILL for ^TMP("GMRCTOT",$J)
4 ; Patch #23 add a KILL for GMRCSVNM
5EN ;GMRC List Manager Routine -- main entry point for GMRC PENDING CONSULTS
6 K GMRCSVC,GMRCSVCP
7 I $D(GMRCEACT),$L(GMRCEACT) D I '$D(^GMR(123.5,$G(GMRCSVC),0)) D EXIT Q
8 .S GMRCSVCP=GMRCEACT
9 .S GMRCSVC=$O(^GMR(123.5,"B",GMRCSVCP,0))
10 .Q:'$D(^GMR(123.5,$G(GMRCSVC),0))
11 .;Build service array
12 .S GMRCDG=GMRCSVC
13 .D SERV1^GMRCASV
14 .S GMRCDT1="ALL"
15 .S GMRCDT2=0
16 .D LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
17 ;If no service ask for one
18 I '$L($G(GMRCSVC)) D EN^GMRCSTLM I $D(GMRCQUT) D EXIT Q
19 ;Quit if no array of services
20 I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 D EXIT Q
21 ;
22 D EN^VALM("GMRC PENDING CONSULTS")
23 ;
24HDR ; -- header code
25 Q:$D(GMRCQUT)!'$D(GMRCCT)
26 S VALMHDR(1)="To Service: "_GMRCHEAD
27 S VALMHDR(2)="From: "_$G(GMRCEDT1)_" To: "_$G(GMRCEDT2)
28 I $G(GMRCCTRL)=1 S VALMCAP=" "_VALMCAP
29 Q
30 ;
31INIT ; -- init variables and list array
32 ;This entry is not used ENORLM^GMRCSTLM is used instead.
33 Q
34 ;
35HELP ; -- help code
36 S X="?" D DISP^XQORM1 W !!
37 Q
38 ;
39EXIT ; -- exit code
40 K CNT,CTRLCOL,GMRCCT,GMRCQUT,GMRCSVC,GMRCSVCP,VALMHDR,GMRCCOMP
41 K GMRCEDT1,GMRCEDT2,GMRCSVNM
42 K GMRCHEAD,GMRCCTRL,GMRCSTAT,GMRCARRN
43 K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J),^TMP("GMRCR",$J,"CP"),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J)
44 Q
45 ;
46EXPND ; -- expand code
47 Q
48 ;
49CWIDTH(GMRCCTRL) ;Prints a message about how wide the report is.
50 N WIDTH
51 S WIDTH=92
52 I GMRCCTRL#100\10 D
53 .I GMRCCTRL#100\10=1 S WIDTH=WIDTH+5
54 .E S WIDTH=WIDTH+10
55 I GMRCCTRL#1000\100 S WIDTH=WIDTH-6
56 Q WIDTH
57 ;
58PWIDTH(GMRCCTRL) ;Prints a message about how wide the report is.
59 W !!,"This print out is "_$$CWIDTH(GMRCCTRL)_" columns wide."
60 Q
61 ;
62PRNTONLY(GMRCCTRL) ;Option to just send the report to a device.
63 N GMRCQUT,RETURN,GMRCDG,GMRCSTAT,VALMBCK
64 N GMRCDT1,GMRCDT2,GMRCEDT1,GMRCEDT2
65 ;Get the statuses
66 S GMRCSTAT=$$STS^GMRCPC1
67 I $D(GMRCQUT) D EXIT Q
68 ;Get the service and date range.
69 D EN^GMRCSTLM
70 I $D(GMRCQUT) D EXIT Q
71 ;Quit if no array of services
72 I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 D EXIT Q
73 I '($D(GMRCCTRL)#2) S GMRCCTRL=0 ;default to just the list
74 D PWIDTH(GMRCCTRL)
75 ;Get the device
76 D PRNTASK^GMRCSTU
77 I $D(GMRCQUT) D EXIT Q
78 ;Save some things if the report is queued
79 I $D(IO("Q")) D
80 .S ZTSAVE("GMRCSTAT")=""
81 .S ZTSAVE("GMRCCTRL")=""
82 ;Create the report if not queued
83 E D ENOR^GMRCSTLM(.RETURN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCCTRL,"CP")
84 ;Print the report
85 D PRNTIT^GMRCSTU("CP","PRNTQ^GMRCPC","CONSULT/REQUEST PACKAGE PRINT SERVICE CONSULTS BY STATUS FROM OPTION")
86 D EXIT
87 Q
88 ;
89PRNTQ ;Print Queued report from ^TMP global then kill off ^TMP & ^XTMP
90 ;Create the report
91 N RETURN,INDEX
92 D ENOR^GMRCSTLM(.RETURN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCCTRL,"CP")
93 U IO
94 S INDEX=""
95 F S INDEX=$O(^TMP("GMRCR",$J,TMPNAME,INDEX)) Q:INDEX="" W ^TMP("GMRCR",$J,TMPNAME,INDEX,0),!
96 K ^TMP("GMRCR",$J,TMPNAME),^XTMP("GMRCR",J,DOLLARH,"PRINT"),J,DOLLARH
97 D ^%ZISC
98 D EXIT
99 Q
100 ;
Note: See TracBrowser for help on using the repository browser.