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