GMRCPC ;SLC/DCM,dee,MA - List Manager Routine: Collect and display consults by service and status ;4/18/01 10:29
;;3.0;CONSULT/REQUEST TRACKING;**1,7,21,23,22**;DEC 27, 1997
; Patch #21 added clean-up KILL for ^TMP("GMRCTOT",$J)
; Patch #23 add a KILL for GMRCSVNM
EN ;GMRC List Manager Routine -- main entry point for GMRC PENDING CONSULTS
K GMRCSVC,GMRCSVCP
I $D(GMRCEACT),$L(GMRCEACT) D I '$D(^GMR(123.5,$G(GMRCSVC),0)) D EXIT Q
.S GMRCSVCP=GMRCEACT
.S GMRCSVC=$O(^GMR(123.5,"B",GMRCSVCP,0))
.Q:'$D(^GMR(123.5,$G(GMRCSVC),0))
.;Build service array
.S GMRCDG=GMRCSVC
.D SERV1^GMRCASV
.S GMRCDT1="ALL"
.S GMRCDT2=0
.D LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
;If no service ask for one
I '$L($G(GMRCSVC)) D EN^GMRCSTLM I $D(GMRCQUT) D EXIT Q
;Quit if no array of services
I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 D EXIT Q
;
D EN^VALM("GMRC PENDING CONSULTS")
;
HDR ; -- header code
Q:$D(GMRCQUT)!'$D(GMRCCT)
S VALMHDR(1)="To Service: "_GMRCHEAD
S VALMHDR(2)="From: "_$G(GMRCEDT1)_" To: "_$G(GMRCEDT2)
I $G(GMRCCTRL)=1 S VALMCAP=" "_VALMCAP
Q
;
INIT ; -- init variables and list array
;This entry is not used ENORLM^GMRCSTLM is used instead.
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K CNT,CTRLCOL,GMRCCT,GMRCQUT,GMRCSVC,GMRCSVCP,VALMHDR,GMRCCOMP
K GMRCEDT1,GMRCEDT2,GMRCSVNM
K GMRCHEAD,GMRCCTRL,GMRCSTAT,GMRCARRN
K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J),^TMP("GMRCR",$J,"CP"),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J)
Q
;
EXPND ; -- expand code
Q
;
CWIDTH(GMRCCTRL) ;Prints a message about how wide the report is.
N WIDTH
S WIDTH=92
I GMRCCTRL#100\10 D
.I GMRCCTRL#100\10=1 S WIDTH=WIDTH+5
.E S WIDTH=WIDTH+10
I GMRCCTRL#1000\100 S WIDTH=WIDTH-6
Q WIDTH
;
PWIDTH(GMRCCTRL) ;Prints a message about how wide the report is.
W !!,"This print out is "_$$CWIDTH(GMRCCTRL)_" columns wide."
Q
;
PRNTONLY(GMRCCTRL) ;Option to just send the report to a device.
N GMRCQUT,RETURN,GMRCDG,GMRCSTAT,VALMBCK
N GMRCDT1,GMRCDT2,GMRCEDT1,GMRCEDT2
;Get the statuses
S GMRCSTAT=$$STS^GMRCPC1
I $D(GMRCQUT) D EXIT Q
;Get the service and date range.
D EN^GMRCSTLM
I $D(GMRCQUT) D EXIT Q
;Quit if no array of services
I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 D EXIT Q
I '($D(GMRCCTRL)#2) S GMRCCTRL=0 ;default to just the list
D PWIDTH(GMRCCTRL)
;Get the device
D PRNTASK^GMRCSTU
I $D(GMRCQUT) D EXIT Q
;Save some things if the report is queued
I $D(IO("Q")) D
.S ZTSAVE("GMRCSTAT")=""
.S ZTSAVE("GMRCCTRL")=""
;Create the report if not queued
E D ENOR^GMRCSTLM(.RETURN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCCTRL,"CP")
;Print the report
D PRNTIT^GMRCSTU("CP","PRNTQ^GMRCPC","CONSULT/REQUEST PACKAGE PRINT SERVICE CONSULTS BY STATUS FROM OPTION")
D EXIT
Q
;
PRNTQ ;Print Queued report from ^TMP global then kill off ^TMP & ^XTMP
;Create the report
N RETURN,INDEX
D ENOR^GMRCSTLM(.RETURN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCCTRL,"CP")
U IO
S INDEX=""
F S INDEX=$O(^TMP("GMRCR",$J,TMPNAME,INDEX)) Q:INDEX="" W ^TMP("GMRCR",$J,TMPNAME,INDEX,0),!
K ^TMP("GMRCR",$J,TMPNAME),^XTMP("GMRCR",J,DOLLARH,"PRINT"),J,DOLLARH
D ^%ZISC
D EXIT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCPC 3256 printed Apr 09, 2024@20:52:38 Page 2
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
+2 ; Patch #21 added clean-up KILL for ^TMP("GMRCTOT",$J)
+3 ; Patch #23 add a KILL for GMRCSVNM
EN ;GMRC List Manager Routine -- main entry point for GMRC PENDING CONSULTS
+1 KILL GMRCSVC,GMRCSVCP
+2 IF $DATA(GMRCEACT)
IF $LENGTH(GMRCEACT)
Begin DoDot:1
+3 SET GMRCSVCP=GMRCEACT
+4 SET GMRCSVC=$ORDER(^GMR(123.5,"B",GMRCSVCP,0))
+5 if '$DATA(^GMR(123.5,$GET(GMRCSVC),0))
QUIT
+6 ;Build service array
+7 SET GMRCDG=GMRCSVC
+8 DO SERV1^GMRCASV
+9 SET GMRCDT1="ALL"
+10 SET GMRCDT2=0
+11 DO LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
End DoDot:1
IF '$DATA(^GMR(123.5,$GET(GMRCSVC),0))
DO EXIT
QUIT
+12 ;If no service ask for one
+13 IF '$LENGTH($GET(GMRCSVC))
DO EN^GMRCSTLM
IF $DATA(GMRCQUT)
DO EXIT
QUIT
+14 ;Quit if no array of services
+15 IF '$ORDER(^TMP("GMRCSLIST",$JOB,0))
SET GMRCQUT=1
DO EXIT
QUIT
+16 ;
+17 DO EN^VALM("GMRC PENDING CONSULTS")
+18 ;
HDR ; -- header code
+1 if $DATA(GMRCQUT)!'$DATA(GMRCCT)
QUIT
+2 SET VALMHDR(1)="To Service: "_GMRCHEAD
+3 SET VALMHDR(2)="From: "_$GET(GMRCEDT1)_" To: "_$GET(GMRCEDT2)
+4 IF $GET(GMRCCTRL)=1
SET VALMCAP=" "_VALMCAP
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 ;This entry is not used ENORLM^GMRCSTLM is used instead.
+2 QUIT
+3 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL CNT,CTRLCOL,GMRCCT,GMRCQUT,GMRCSVC,GMRCSVCP,VALMHDR,GMRCCOMP
+2 KILL GMRCEDT1,GMRCEDT2,GMRCSVNM
+3 KILL GMRCHEAD,GMRCCTRL,GMRCSTAT,GMRCARRN
+4 KILL ^TMP("GMRCS",$JOB),^TMP("GMRCSLIST",$JOB),^TMP("GMRCR",$JOB,"CP"),^TMP("GMRCRINDEX",$JOB),^TMP("GMRCTOT",$JOB)
+5 QUIT
+6 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
CWIDTH(GMRCCTRL) ;Prints a message about how wide the report is.
+1 NEW WIDTH
+2 SET WIDTH=92
+3 IF GMRCCTRL#100\10
Begin DoDot:1
+4 IF GMRCCTRL#100\10=1
SET WIDTH=WIDTH+5
+5 IF '$TEST
SET WIDTH=WIDTH+10
End DoDot:1
+6 IF GMRCCTRL#1000\100
SET WIDTH=WIDTH-6
+7 QUIT WIDTH
+8 ;
PWIDTH(GMRCCTRL) ;Prints a message about how wide the report is.
+1 WRITE !!,"This print out is "_$$CWIDTH(GMRCCTRL)_" columns wide."
+2 QUIT
+3 ;
PRNTONLY(GMRCCTRL) ;Option to just send the report to a device.
+1 NEW GMRCQUT,RETURN,GMRCDG,GMRCSTAT,VALMBCK
+2 NEW GMRCDT1,GMRCDT2,GMRCEDT1,GMRCEDT2
+3 ;Get the statuses
+4 SET GMRCSTAT=$$STS^GMRCPC1
+5 IF $DATA(GMRCQUT)
DO EXIT
QUIT
+6 ;Get the service and date range.
+7 DO EN^GMRCSTLM
+8 IF $DATA(GMRCQUT)
DO EXIT
QUIT
+9 ;Quit if no array of services
+10 IF '$ORDER(^TMP("GMRCSLIST",$JOB,0))
SET GMRCQUT=1
DO EXIT
QUIT
+11 ;default to just the list
IF '($DATA(GMRCCTRL)#2)
SET GMRCCTRL=0
+12 DO PWIDTH(GMRCCTRL)
+13 ;Get the device
+14 DO PRNTASK^GMRCSTU
+15 IF $DATA(GMRCQUT)
DO EXIT
QUIT
+16 ;Save some things if the report is queued
+17 IF $DATA(IO("Q"))
Begin DoDot:1
+18 SET ZTSAVE("GMRCSTAT")=""
+19 SET ZTSAVE("GMRCCTRL")=""
End DoDot:1
+20 ;Create the report if not queued
+21 IF '$TEST
DO ENOR^GMRCSTLM(.RETURN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCCTRL,"CP")
+22 ;Print the report
+23 DO PRNTIT^GMRCSTU("CP","PRNTQ^GMRCPC","CONSULT/REQUEST PACKAGE PRINT SERVICE CONSULTS BY STATUS FROM OPTION")
+24 DO EXIT
+25 QUIT
+26 ;
PRNTQ ;Print Queued report from ^TMP global then kill off ^TMP & ^XTMP
+1 ;Create the report
+2 NEW RETURN,INDEX
+3 DO ENOR^GMRCSTLM(.RETURN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCCTRL,"CP")
+4 USE IO
+5 SET INDEX=""
+6 FOR
SET INDEX=$ORDER(^TMP("GMRCR",$JOB,TMPNAME,INDEX))
if INDEX=""
QUIT
WRITE ^TMP("GMRCR",$JOB,TMPNAME,INDEX,0),!
+7 KILL ^TMP("GMRCR",$JOB,TMPNAME),^XTMP("GMRCR",J,DOLLARH,"PRINT"),J,DOLLARH
+8 DO ^%ZISC
+9 DO EXIT
+10 QUIT
+11 ;
