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