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

GMRCSTLM.m

Go to the documentation of this file.
  1. GMRCSTLM ;SLC/DCM,dee,MA - List Manager Format Routine - Get Active Consults by service - pending,active,scheduled,incomplete,etc. ;11/21/02 05:29
  1. ;;3.0;CONSULT/REQUEST TRACKING;**1,7,21,23,22,29,63**;DEC 27, 1997;Build 10
  1. ; Patch #21 added a initialization KILL for ^TMP("GMRCTOT",$J)
  1. ; Patch #23 remove the default prompt "ALL SERVICES"
  1. Q
  1. ;
  1. EN ;Ask for new service and date range
  1. K GMRCQUT
  1. N DIROUT,DTOUT,DUOUT,DIR
  1. ;
  1. ;Ask for service
  1. N Y
  1. S DIR(0)="PO^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
  1. S DIR("A")="Select Service/Specialty"
  1. D ^DIR
  1. I Y<1 S VALMBCK="Q" Q
  1. S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2)
  1. D SERV1^GMRCASV
  1. I '$O(^TMP("GMRCSLIST",$J,0)) S VALMBCK="Q" Q
  1. ;
  1. ;Ask for date range
  1. D ^GMRCSPD
  1. I $D(GMRCQUT) S VALMBCK="Q" G EXIT
  1. D LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
  1. Q
  1. ;
  1. ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCCTRL,GMRCARRN) ;Entry point for GUI interface.
  1. ;.RETURN: This is the root to the returned temp array.
  1. ;GMRCSVC: Service for which consults are to be displayed.
  1. ;GMRCDT1: Starting date or "ALL"
  1. ;GMRCDT2: Ending date if not GMRCDT1="ALL"
  1. ;GMRCSTAT: The list of status to include separated by commas
  1. ;GMRCCTRL: 0, null or not define then just the display list is
  1. ; displayed
  1. ; 1 then the list will be two pieces with the first piece
  1. ; being the ien of the consult for selection in the gui
  1. ; and the second piece being the display text.
  1. ; 10 then the consults will have a line number on them for
  1. ; selection
  1. ; 20 then the consults will have the consult number displayed
  1. ; 100 then use abbreviations for the statuses
  1. ; 1, (10 or 20) and 100 can be added together to add there features
  1. ;GMRCARRN: List Template Array Name
  1. ; "CP": pending; "IFC": inter-facility
  1. ;
  1. ;This temp array is used internally by the report:
  1. ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
  1. ; status is "" tracking and/or grouper
  1. ; 1 grouper only
  1. ; 2 tracking only
  1. ; 9 disabled
  1. ;
  1. N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCCT,GMRCGRP,VALMCNT,VALMBCK
  1. K ^TMP("GMRCR",$J,GMRCARRN)
  1. S RETURN="^TMP(""GMRCR"",$J,GMRCARRN)"
  1. I '($D(GMRCSVC)#2) S GMRCSVC=1
  1. Q:'$D(^GMR(123.5,$G(GMRCSVC),0))
  1. ;Build service array
  1. S GMRCDG=GMRCSVC
  1. D SERV1^GMRCASV
  1. ;Get external form of date range
  1. I '($D(GMRCDT1)#2) S GMRCDT1="ALL"
  1. S:GMRCDT1="ALL" GMRCDT2=0
  1. D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
  1. G ENORSTR
  1. ;
  1. ENORLM(GMRCARRN) ;Entry point for List Manager interface.
  1. ; Input -- GMRCARRN List Template Array Name
  1. ; "CP": pending; "IFC": inter-facility
  1. ; Output - None
  1. D WAIT^DICD
  1. ;
  1. ENORSTR ;Common part
  1. N GMRCDA,NUMCLIN,INDEX,STATUS,LOOP,GROUPER
  1. N STS,GMRCD,GMRCDT,GMRCSVCG,TEMP
  1. N GMRCPT,CTRLTEMP,LINETEMP,GMRCLINE
  1. N GMRCPTN,GMRCPTSN,GMRCDLA,GMRCXDT,GMRCLOC,GMRCSVCP
  1. N GRP,GMRCIRF,GMRCIRFN,GMRCIDD,GMRCST,GMRCRDT,CNT,IDX
  1. S:'$D(GMRCARRN) GMRCARRN="CP"
  1. ;
  1. ; Patch #21 added the kill for ^TMP("GMRCTOT",$J)
  1. K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J),^TMP("GMRCT",$J)
  1. K ^TMP("GMRCTOTX",$J),GMRCCNSLT
  1. ;
  1. S CNT=0
  1. S GMRCCT=0
  1. S NUMCLIN=0
  1. S GMRCLINE=0
  1. S GROUPER=0
  1. S GROUPER(0)=0
  1. S GMRCCT=GMRCCT+1
  1. I '($D(GMRCCTRL)#2) S GMRCCTRL=0 ;default to just the list
  1. S CTRLTEMP=$S(GMRCCTRL#2:"^",1:"")
  1. I GMRCARRN="IFC" D
  1. .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_$J("",18)_"IF Consult/Request By Status - "_$S(GMRCIS="R":"Requesting",1:"Consulting")_" Site"
  1. E D
  1. .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_$J("",28)_"Consult/Request By Status"
  1. S GMRCCT=GMRCCT+1
  1. S TEMP="FROM: "_GMRCEDT1_" TO: "_GMRCEDT2
  1. S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_$J("",40-($L(TEMP)/2)+.5)_TEMP
  1. I GMRCARRN="IFC",$D(GMRCRF),$D(GMRCREMP) D
  1. .S GMRCCT=GMRCCT+1
  1. .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_"Routing Facility - "_$$GET1^DIQ(4,GMRCRF,.01)
  1. .S GMRCCT=GMRCCT+1
  1. .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_"Remote Ordering Provider - "_GMRCREMP
  1. I GMRCCTRL=120 D
  1. .S GMRCCT=GMRCCT+1
  1. .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP
  1. .S GMRCCT=GMRCCT+1
  1. .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=" Number St Last Action Req Dt Patient Name Patient Location"_$S(GMRCARRN="IFC":" Routing Facility Days Diff"_$S(GMRCIS="C":" Rec Dt",1:""),1:"")
  1. ;
  1. I '($D(GMRCSVC)#2) S GMRCSVC=1
  1. I '($D(GMRCDT1)#2) S GMRCDT1="ALL",GMRCDT2=0
  1. I '($D(GMRCDT2)#2) S GMRCDT2=""
  1. I '($D(GMRCSTAT)#2),GMRCARRN="CP" S GMRCSTAT="3,4,5,6,8,9,11,99" ;pending consults
  1. I '($D(GMRCSTAT)#2),GMRCARRN="IFC" S GMRCSTAT="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,99"
  1. ;
  1. CAPTION ;Set the List Mangager Caption Line
  1. ; Does GMRCCTRL contain 10 i.e. display line numbers
  1. ; or 20 i.e. display consult number
  1. I $G(VALMAR)="^TMP(""GMRCR"",$J,""CP"")"!($G(VALMAR)="^TMP(""GMRCR"",$J,""IFC"")") D
  1. .I GMRCCTRL#100\10 D
  1. ..I GMRCCTRL#100\10=1 D
  1. ...; Does GMRCCTRL contain 100 i.e. use abbreviations for the statuses
  1. ...I GMRCCTRL#1000\100 D CHGCAP^VALM("CAPTION LINE"," St Last Action Request Date Patient Name Pt Location")
  1. ...; Do not use abbreviations for the statuses
  1. ...E D CHGCAP^VALM("CAPTION LINE"," Status Last Action Request Date Patient Name Pt Location")
  1. ..; Do not display consult number
  1. ..E D
  1. ...; Does GMRCCTRL contain 100 i.e. use abbreviations for the statuses
  1. ...I GMRCCTRL#1000\100 D CHGCAP^VALM("CAPTION LINE"," Number St Last Action Request Date Patient Name Pt Location")
  1. ...; Do not use abbreviations for the statuses
  1. ...E D CHGCAP^VALM("CAPTION LINE"," Number Status Last Action Request Date Patient Name Pt Location")
  1. .E D
  1. ..; Does GMRCCTRL contain 100 i.e. use abbreviations for the statuses
  1. ..I GMRCCTRL#1000\100 D CHGCAP^VALM("CAPTION LINE","St Last Action Request Date Patient Name Pt Location")
  1. ..; Do not use abbreviations for the statuses
  1. ..E D CHGCAP^VALM("CAPTION LINE","Status Last Action Request Date Patient Name Pt Location")
  1. .I GMRCARRN="IFC" D
  1. ..D CHGCAP^VALM("CAPTION LINE 1","Routing Facility Days Diff"_$S(GMRCIS="C":" Rec Date",1:""))
  1. ;Set screen width
  1. S VALM("RM")=$S(GMRCARRN="CP":$$CWIDTH^GMRCPC(GMRCCTRL),1:$$CWIDTH^GMRCIR(GMRCCTRL))
  1. ;
  1. S GMRCHEAD=$P($G(^TMP("GMRCSLIST",$J,+$O(^TMP("GMRCSLIST",$J,"")))),"^",2)
  1. S INDEX=""
  1. SVC ;Loop on Service
  1. F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX="" D
  1. .S GMRCSVC=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
  1. .S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,INDEX),"^",2)
  1. .S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)
  1. .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0
  1. .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=0
  1. .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"T")=0
  1. .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"P")=0
  1. .I GMRCARRN="IFC" D
  1. ..S GMRCST(1,GMRCSVC)="0^0"
  1. ..S GMRCST(2,GMRCSVC)="0^0"
  1. GROUPER .;Check if starting a new Grouper
  1. .F Q:GROUPER(GROUPER)=GMRCSVCG D
  1. ..;End of a group so print the group totals
  1. ..D LISTTOT^GMRCSTL1(.GMRCCT,2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),"",GMRCCTRL,GMRCARRN)
  1. ..;pop grouper from stack
  1. ..S GROUPER=GROUPER-1
  1. .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
  1. ..;Start of a new group so print the group heading.
  1. ..S GMRCCT=GMRCCT+1
  1. ..S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP
  1. ..S GMRCCT=GMRCCT+1
  1. ..S TEMP="GROUPER: "_GMRCSVCP
  1. ..S:GMRCSVCG>0 TEMP=TEMP_" in Group: "_$P(^GMR(123.5,GMRCSVCG,0),"^",1)
  1. ..S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_$J("",40-(($L(TEMP)/2)+.5))_TEMP
  1. ..;push new grouper on stack
  1. ..S GROUPER=GROUPER+1
  1. ..S GROUPER(GROUPER)=GMRCSVC
  1. STAT .;Loop for one status at a time
  1. .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D ONESTAT^GMRCSTL2(GMRCARRN)
  1. .F GRP=GROUPER:-1:1 D
  1. ..; pending for this service to all of its groupers
  1. ..I $D(^TMP("GMRCTOTX",$J,GROUPER(GRP),GMRCSVC,"P")) Q
  1. ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"P")
  1. ..S ^TMP("GMRCTOTX",$J,GROUPER(GRP),GMRCSVC,"P")=""
  1. ..I $D(^TMP("GMRCTOTX",$J,GROUPER(GRP),GMRCSVC,"T")) Q
  1. ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"T")
  1. ..S ^TMP("GMRCTOTX",$J,GROUPER(GRP),GMRCSVC,"T")=""
  1. ..;IF Consults
  1. ..I GMRCARRN="IFC" S GMRCIRFN="" F S GMRCIRFN=$O(^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)) Q:GMRCIRFN="" D
  1. ...I '$D(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"F",GMRCIRFN)) D
  1. ....S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"F",GMRCIRFN)=0
  1. ....S GMRCST(2,GROUPER(GRP),GMRCIRFN)="0^0"
  1. ...S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"F",GMRCIRFN)=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"F",GMRCIRFN))+^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)
  1. ...I +$P(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2)>0 D
  1. ....S $P(GMRCST(2,GROUPER(GRP),GMRCIRFN),"^")=($P(GMRCST(2,GROUPER(GRP)),"^"))+($P(GMRCST(1,GMRCSVC,GMRCIRFN),"^"))
  1. ....S $P(GMRCST(2,GROUPER(GRP),GMRCIRFN),"^",2)=($P(GMRCST(2,GROUPER(GRP),GMRCIRFN),"^",2))+($P(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2))
  1. ..I GMRCARRN="IFC" D
  1. ...S $P(GMRCST(2,GROUPER(GRP)),"^")=($P(GMRCST(2,GROUPER(GRP)),"^"))+($P(GMRCST(1,GMRCSVC),"^"))
  1. ...S $P(GMRCST(2,GROUPER(GRP)),"^",2)=($P(GMRCST(2,GROUPER(GRP)),"^",2))+($P(GMRCST(1,GMRCSVC),"^",2))
  1. .;
  1. PRINTST .;Print the totals for this service that are >0
  1. .S GMRCSVNM=GMRCHEAD
  1. .I ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")>0 D LISTTOT^GMRCSTL1(.GMRCCT,1,GMRCSVC,GMRCSVCP,$P($G(^GMR(123.5,GMRCSVCG,0)),"^",1),GMRCCTRL,GMRCARRN)
  1. .I ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0,GMRCSVNM'="ALL SERVICES" D
  1. ..S GMRCCT=GMRCCT+1
  1. ..S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP
  1. ..S GMRCCT=GMRCCT+1
  1. ..S TEMP="SERVICE: "_GMRCSVCP
  1. ..S:GMRCSVCG>0 TEMP=TEMP_" in Group: "_$P(^GMR(123.5,GMRCSVCG,0),"^",1)
  1. ..S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_TEMP
  1. ..S NUMCLIN=NUMCLIN+1
  1. ..D LISTTOT^GMRCSTL1(.GMRCCT,1,GMRCSVC,GMRCSVCP,$P($G(^GMR(123.5,GMRCSVCG,0)),"^",1),GMRCCTRL,GMRCARRN)
  1. .I ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0,GMRCSVNM="ALL SERVICES" D
  1. ..S CNT=CNT+1
  1. ..S ^TMP("GMRCT",$J,0,GMRCSVC)=""
  1. ;
  1. ;Done so
  1. ;Now list the group totals for the current groups
  1. F GROUPER=GROUPER:-1:1 D
  1. .D LISTTOT^GMRCSTL1(.GMRCCT,2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),"",GMRCCTRL,GMRCARRN)
  1. ;
  1. I CNT D
  1. .S GMRCCT=GMRCCT+1
  1. .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP,GMRCCT=GMRCCT+1
  1. .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_"The following Consult Services had zero requests for the specified date range:",GMRCCT=GMRCCT+1
  1. .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP,GMRCCT=GMRCCT+1
  1. .S IDX="" F S IDX=$O(^TMP("GMRCT",$J,0,IDX)) Q:IDX="" D
  1. ..I $P(^GMR(123.5,IDX,0),U,2)=1 Q ;don't add to list if service is a grouper only...
  1. ..S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_$P(^GMR(123.5,IDX,0),U,1),GMRCCT=GMRCCT+1
  1. ;
  1. S VALMCNT=$O(^TMP("GMRCR",$J,GMRCARRN," "),-1)
  1. I $D(IOBM),$D(IOTM) S VALMBCK="R"
  1. EXIT Q
  1. ;