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

GMRCIR.m

Go to the documentation of this file.
  1. GMRCIR ;SLC/JAK - IFC Request data & statistics ;03/05/02 08:20
  1. ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
  1. EN ; -- main entry point for GMRC IF CONSULTS
  1. K GMRCSVC,GMRCSVCP
  1. N GMRCCK,GMRCDG,GMRCIS,GMRCSTAT
  1. N GMRCDT1,GMRCDT2,GMRCEDT1,GMRCEDT2
  1. I $D(GMRCREMP),$D(GMRCRF) D
  1. .I '$D(^GMR(123,"AIP")) D
  1. ..W !!,$C(7),"No entries with Remote Ordering Provider data.",!
  1. ..S GMRCQUT=1
  1. .E D
  1. ..N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. ..S DIR(0)="PO^4:EMQ"
  1. ..S DIR("S")="I $$STA^XUAF4(+Y)=+$$STA^XUAF4(+Y)"
  1. ..S DIR("A")="Select Requesting site"
  1. ..D ^DIR I $D(DIRUT) S GMRCQUT=1 Q
  1. ..S GMRCRF=+Y
  1. ..W !
  1. ..N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. ..S DIR(0)="FO^2:40^D UP^GMRCA2 K:'$D(^GMR(123,""AIP"",X)) X"
  1. ..S DIR("?")="^D HELPR^GMRCIR"
  1. ..S DIR("A",1)=" Enter the ENTIRE name in proper CASE, exactly as it"
  1. ..S DIR("A",2)=" appears in the list (including any credentials)."
  1. ..S DIR("A",3)=" Use copy/paste to avoid typing errors."
  1. ..S DIR("A",4)=" NO partial matches are done."
  1. ..S DIR("A",5)=" Enter ? to display a list of possible entries."
  1. ..S DIR("A")="Select Remote Ordering Provider"
  1. ..D ^DIR I $D(DIRUT) S GMRCQUT=1 Q
  1. ..D UP^GMRCA2 S Y=X,GMRCREMP=Y
  1. .S GMRCIS="C"
  1. E D
  1. .N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. .S DIR(0)="SB^R:REQUESTING;C:CONSULTING"
  1. .S DIR("A")="Are you the Requesting site or the Consulting site"
  1. .D ^DIR I $D(DIRUT) S GMRCQUT=1 Q
  1. .S GMRCIS=Y
  1. I $D(GMRCQUT) D EXIT Q
  1. ;Get the statuses
  1. S GMRCSTAT=$$STS^GMRCPC1
  1. I $D(GMRCQUT) D EXIT Q
  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. .;Set date range to ALL
  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 IF CONSULTS")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. Q:$D(GMRCQUT)!'$D(GMRCCT)
  1. S VALMHDR(1)="IFC Requests: "_$S(GMRCIS="R":"Requesting",1:"Consulting")_" Site"
  1. S VALMHDR(2)="Service: "_GMRCHEAD
  1. S VALMHDR(3)="From: "_$G(GMRCEDT1)_" To: "_$G(GMRCEDT2)
  1. I $G(GMRCCTRL)=1 S VALMCAP=" "_VALMCAP
  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
  1. K GMRCEDT1,GMRCEDT2,GMRCSVNM
  1. K GMRCCTRL,GMRCSTAT,GMRCARRN
  1. K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J),^TMP("GMRCR",$J,"IFC"),^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=128
  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. HELPR ;Help for Remote Ordering Provider prompt
  1. N GMRCRP,GMRCQUT
  1. S GMRCRP=""
  1. W @IOF
  1. F S GMRCRP=$O(^GMR(123,"AIP",GMRCRP)) Q:GMRCRP=""!$D(GMRCQUT) D
  1. .W GMRCRP,!
  1. .I $Y>(IOSL-4) N X,Y D W:Y @IOF I 'Y S GMRCQUT=1 Q
  1. ..N DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. ..S DIR(0)="E" D ^DIR
  1. I $D(GMRCQUT) Q
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="E",DIR("A")="Enter RETURN or '^' to exit" D ^DIR
  1. Q
  1. ;
  1. DESC ;Displays Description from Option file
  1. N GMRCDESC,GMRCNUM,GMRCOPT,GMRCOPTN,GMRCQUT
  1. S GMRCNUM=""
  1. S GMRCOPTN="GMRC IFC RPT CONSULTS"
  1. S GMRCOPT=$$FIND1^DIC(19,"","X",GMRCOPTN)
  1. I 'GMRCOPT Q
  1. S GMRCDESC=$$GET1^DIQ(19,GMRCOPT,3.5,"","GMRCDESC") ; DBIA #10075
  1. I '$O(GMRCDESC(0)) Q
  1. W @IOF F S GMRCNUM=$O(GMRCDESC(GMRCNUM)) Q:GMRCNUM=""!$D(GMRCQUT) D
  1. .W GMRCDESC(GMRCNUM),!
  1. .I $Y>(IOSL-4) N X,Y D W:+Y @IOF I '+Y S GMRCQUT=1 Q
  1. ..N DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. ..S DIR(0)="E" D ^DIR
  1. I $D(GMRCQUT) Q
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="E",DIR("A")="Enter RETURN or '^' to exit" D ^DIR
  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. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMRCIS,GMRCCK,X,Y
  1. S DIR(0)="SB^R:REQUESTING;C:CONSULTING"
  1. S DIR("A")="Are you the Requesting site or the Consulting site"
  1. D ^DIR Q:$D(DIRUT) S GMRCIS=Y
  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. ;Get description?
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="Y",DIR("B")="NO"
  1. S DIR("A")="Want to view a description of the data for this report now"
  1. D ^DIR I $D(DIRUT) D EXIT Q
  1. I Y>0 D DESC
  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("GMRCCTRL")=""
  1. .S ZTSAVE("GMRCIS")=""
  1. .S ZTSAVE("GMRCSTAT")=""
  1. ;Create the report if not queued
  1. E D ENOR^GMRCSTLM(.RETURN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCCTRL,"IFC")
  1. ;Print the report
  1. D PRNTIT^GMRCSTU("IFC","PRNTQ^GMRCIR","CONSULT/REQUEST PACKAGE PRINT INTER-FACILITY CONSULT REQUESTS 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,"IFC")
  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. ;