- 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 Jan 18, 2025@02:47:52 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 ;