Changeset 636 for FOIAVistA/tag/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTL7.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTL7.m (modified) (9 diffs)

FOIAVistA/tag/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTL7.m

@@ -1 @@
-GMRCSTL7 ;SLC/JFR/WAT - DRIVER FOR CSLT PER MONITOR ;4/8/05 10:28
- ;;3.0;CONSULT/REQUEST TRACKING;**41,60**;DEC 27, 1997;Build 9
+GMRCSTL7 ;SLC/JFR - DRIVER FOR CSLT PER MONITOR ;4/8/05 10:28
+ ;;3.0;CONSULT/REQUEST TRACKING;**41**;DEC 27, 1997
  ;
- ;This routine invokes ICRs 
- ;1519(XUTMDEVQ,10103(XLFDT),10104(XLFSTR),3744(VADPT),10089(%ZISC),10026(DIR)
  Q
  ;
 EN ; start here
  K GMRCQUT
- N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
+ N DIROUT,DTOUT,DUOUT,DIR,DIRUT,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
  N GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE
- N GMRC30ST,GMRC30SP
- D CAVEATS
+ ;
  ;Ask for service
- S DIR(0)="P^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
+ N Y
+ S DIR(0)="PO^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
  S DIR("A")="Select Service/Specialty"
  D ^DIR
- I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
+ I Y<1 Q
  S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2)
-  ;Ask for current FY
- N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCFY
- S DIR(0)="F^4:4^K:(X-1700)>($E(DT,1,3)+1) X"
- S DIR("A")="Current Fiscal Year (i.e. 2008)"
- S DIR("A",1)="Ensure you are providing fiscal year, NOT calendar year."
- D ^DIR
- I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
- S GMRCFY=X
- N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCQTR,GMRCYR
- S DIR(0)="N^1:4"
- S DIR("A")="Enter a number 1 - 4"
- S DIR("A",1)="For which quarter are you running the report: first, second, third or fourth?"
- D ^DIR
- I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
- S GMRCQTR=X
- ;if first quarter
- I $G(GMRCQTR)=1 D
- .;use FY-1 to set year part of date range to the previous calendar year
- .S GMRCYR=$G(GMRCFY)-1700 S GMRCYR=$G(GMRCYR)-1,GMRCDT1=$E($G(GMRCYR),1,3)_"1001" S GMRCDT2=$G(GMRCYR)_"1231"
- I $G(GMRCQTR)=2 D
- .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0101" S GMRCDT2=$G(GMRCYR)_"0331"
- I $G(GMRCQTR)=3 D
- .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0401" S GMRCDT2=$G(GMRCYR)_"0630"
- I $G(GMRCQTR)=4 D
- .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0701" S GMRCDT2=$G(GMRCYR)_"0930"
- S GMRC30ST=$$FMADD^XLFDT(GMRCDT1,-30),GMRC30SP=$$FMADD^XLFDT(GMRCDT2,-30)
+ ;
+ ;Ask for date range
+ D ^GMRCSPD
+ I $D(GMRCQUT) G EXIT
+ ;
  ; what type of report
- N DIROUT,DTOUT,DUOUT,DIR,Y,X
+ K DIR,X,Y
  S DIR(0)="S:O^S:Summary;D:Delimited",DIR("A")="What type of report"
  D ^DIR
- I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
+ I Y="" G EXIT
  S GMRCFMT=$S(Y="S":"CP",1:"DEL")
  ;
@@ -56 +33 @@
  S GMRCSAVE("GMRCDT1")=""
  S GMRCSAVE("GMRCDT2")=""
- S GMRCSAVE("GMRC30ST")=""
- S GMRCSAVE("GMRC30SP")=""
  S GMRCSAVE("GMRCSVNM")=""
- S GMRCSAVE("GMRCFY")=""
- S GMRCSAVE("GMRCQTR")=""
  ;
- N DIROUT,DTOUT,DUOUT,DIR,Y,X S DIR(0)="FO",DIR("A")="ENTER ""?"" FOR MORE HELP OR RETURN TO CONTINUE"
- S DIR("A",1)="MARGIN WIDTH IS BEST AT 256"
- S DIR("?")="^D MARGHLP^GMRCSTL7"
- D:GMRCFMT="DEL" ^DIR
- I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) D EXIT Q
  D EN^XUTMDEVQ("PRNTQ^GMRCSTL7","CONSULT PERFORMANCE MONITOR",.GMRCSAVE)
  ;
@@ -72 +40 @@
  ;
  Q
-MARGHLP ;help text to set margins
- W !,"Specify a device with optional parameters in the format"
- W !,?8,"Device Name;Right Margin;Page Length"
- W !,?21,"or"
- W !,?5,"Device Name;Subtype;Right Margin;Page Length"
- W !!,"Or in the new format"
- W !,?14,"Device Name;/settings"
- W !,?21,"or"
- W !,?10,"Device Name;Subtype;/settings"
- W !,"For example"
- W !,?17,"HOME;80;999"
- W !,?21,"or"
- W !,?13,"HOME;C-VT320;/M80L999"
- Q
  ;
-ENOR(RETURN,GMRCSVC,GMRC30ST,GMRC30SP,GMRCSTAT,GMRCST2,GMRCARRN) ;Entry point 
+ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCARRN) ;Entry point 
  ;.RETURN:   This is the root to the returned temp array.
  ;GMRCSVC:  Service for which consults are to be displayed.
- ;GMRC30ST:  30 days prior to quarter start date
- ;GMRC30SP:  30 days prior to quarter end date
+ ;GMRCDT1:  Starting date or "ALL"
+ ;GMRCDT2:  Ending date if not GMRCDT1="ALL"
  ;GMRCSTAT: The list of status to include separated by commas
  ;GMRCARRN: Format of report becomes ^TMP array element
@@ -112 +66 @@
  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)
  ;
- N GMRCDA,INDEX,STATUS,STATUS2,LOOP,GROUPER
- N GMRCSVCG,GMRCPT,GMRCSVCP,GRP,PIECE,TYPE
+ N GMRCDA,INDEX,STATUS,LOOP,GROUPER
+ N STS,GMRCD,GMRCDT,GMRCSVCG,TEMP,GMRCPT,LINETEMP
+ N GMRCPTN,GMRCPTSN,GMRCDLA,GMRCXDT,GMRCLOC,GMRCSVCP
+ N GRP,GMRCIRF,GMRCIRFN,GMRCIDD,GMRCST,GMRCRDT
  ;
- K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCT",$J)
+ K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J)
  ;
  S GROUPER=0
@@ -123 +81 @@
  I GMRCARRN="DEL" D
  . N STR
- . S STR="Svc;30DayRng;60DayRng;CmpIn30;Cmp31-60;B4Qtr;PndB4Qtr;%Cmp30;%Cmp60;%UnRsB4Qtr;IS30Rng;IS60Rng;ISCmp30;ISCmp31-60;ISB4Qtr;ISPndB4Qtr;%ISCmp30;%ISCmp60;%ISUnRsB4Qtr;"
- . S STR=STR_"IR30Rng;IR60Rng;IRCmp30;IRCmp31-60;IRB4Qtr;IRPndB4Qtr;%IRCmp30;%IRCmp60;%IRUnRsB4Qtr"
+ . S STR="Service;Total;Unresolved;Complete;Comp w/Results;%Complete;"
+ . S STR=STR_"%Comp w/Results"
  . S ^TMP("GMRCR",$J,GMRCARRN,1,0)=STR
  S INDEX=""
@@ -132 +90 @@
  .S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,INDEX),"^",2)
  .S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)
- .N SUBIDX
- .;pieces for tmp arrays, 1 to 6 are local, 7 to 12 are IFC placer, 13 to 18 are IFC filler
- .;;total for 30 day start/end^total for 60 day start/end^results n 30 days^results n 60 days^total before quarter^total pending before quarter
- .S ^TMP("GMRCT",$J,1,GMRCSVC,"DATA")="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
- .S ^TMP("GMRCT",$J,2,GMRCSVC,"DATA")="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
- .;Check if starting a new Grouper
- .F  Q:GROUPER(GROUPER)=GMRCSVCG  D
+ .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0
+ .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=0
+ .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"R")=0
+ .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"C")=0
+ .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"T")=0
+ .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"P")=0
+ .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"R")=0
+ .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"C")=0
+ . ;Check if starting a new Grouper
+ . F  Q:GROUPER(GROUPER)=GMRCSVCG  D
  ..;End of a group so print the group totals
  ..I GROUPER(GROUPER)=GMRCSVCG D 
  ... I GMRCARRN="CP" D
- ....D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
- ...I GMRCARRN="DEL" D
- ....D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
+ .... D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
+ ... I GMRCARRN="DEL" D
+ .... D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
  ..;pop grouper from stack
  ..S GROUPER=GROUPER-1
@@ -153 +114 @@
  .;Loop for one status at a time
  .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
- ..D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,GMRC30ST,GMRC30SP,"30")
- .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
- ..D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,$$FMADD^XLFDT(GMRC30ST,-30),$$FMADD^XLFDT(GMRC30SP,-30),"60")
- .S GMRCDT1=$$FMADD^XLFDT(GMRC30ST,30) ;add 30 days back to set date back to start of FY quarter.
- .F LOOP=1:1:$L(GMRCST2,",") S STATUS2=$P(GMRCST2,",",LOOP) D
- ..D ONESTAT2^GMRCSTL8(GMRCARRN,INDEX,STATUS2,$$FMADD^XLFDT(GMRCDT1,-60))
+ .. D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,GMRCDT1,GMRCDT2)
  .F GRP=GROUPER:-1:1 D
- ..F PIECE=1:1:18 D
- ...S $P(^TMP("GMRCT",$J,2,GROUPER(GRP),"DATA"),U,PIECE)=$P(^TMP("GMRCT",$J,2,GROUPER(GRP),"DATA"),U,PIECE)+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,PIECE)
+ ..;  pending for this service to all of its groupers
+ ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"P")
+ .. ; completed w/results for all groupers
+ .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"R")
+ ..;  for all status for this service to all of its groupers
+ ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"T")
+ .. ; add all completed for all groupers
+ .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"C")
  .;
  .;Print the totals for this service that are >0
- .I GMRCARRN="CP" D
- ..D PRTTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
- .I GMRCARRN="DEL" D
- ..D DELTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
- .Q
+ . I GMRCARRN="CP" D 
+ .. D PRTTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
+ . I GMRCARRN="DEL" D
+ .. D DELTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
+ . Q
  ;
  ;Done, so now list the group totals for the top group
  ;F GROUPER=GROUPER:-1:1 D  ; left for looking at all totals in future
  I $G(GROUPER) S GROUPER=1 D
- .I GMRCARRN="CP" D
- ..D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
- .I GMRCARRN="DEL" D
- ..D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
+ . I GMRCARRN="CP" D 
+ .. D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
+ . I GMRCARRN="DEL" D
+ .. D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
  Q
+ ;
 PRNTQ   ;Build report and print it
  ;
@@ -184 +147 @@
  D SERV1^GMRCASV
  D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
- S TEMP=$S($G(GMRCQTR)=4:"4",$G(GMRCQTR)=3:"3",$G(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$E($G(GMRCFY),3,4)
- S TEMP="Consult/Request Performance Monitor - "_TEMP
- W $J("",40-($L(TEMP)/2)+.5)_TEMP
- S TEMP="Fiscal Quarter Dates: "_$$FMTE^XLFDT(GMRCDT1)_" - "_$$FMTE^XLFDT(GMRCDT2)
- W !,$J("",40-($L(TEMP)/2)+.5)_TEMP
- S TEMP="30 Days Before Start/End: "_$$FMTE^XLFDT(GMRC30ST)_" - "_$$FMTE^XLFDT(GMRC30SP)
- W !,$J("",40-($L(TEMP)/2)+.5)_TEMP
- S TEMP="60 Days Before Start/End: "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30ST,-30))_" - "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30SP,-30))
+ W !,$J("",23)_"Consult/Request Performance Monitor"
+ S TEMP="FROM: "_$$FMTE^XLFDT(GMRCDT1)_"  TO: "_$$FMTE^XLFDT(GMRCDT2)
+ I GMRCDT1="ALL" S TEMP="ALL DATES"
  W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
- I '$D(IO("Q")) D WAIT^DICD W !!
  I '$O(^TMP("GMRCSLIST",$J,0)) D  G EXIT
- .W !!,"No records to print"
- D ENOR^GMRCSTL7(.GMRCTMP,GMRCDG,GMRC30ST,GMRC30SP,"2,5,6,8,9","1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,99",GMRCFMT)
+ . W !!,"No records to print"
+ D ENOR^GMRCSTL7(.GMRCTMP,GMRCDG,GMRCDT1,GMRCDT2,"5,6,8,2,9",GMRCFMT)
  I '$D(^TMP("GMRCR",$J,GMRCFMT)) D
- .W !!,"No records to print",!
+ . W !!,"No records to print",!
  S IDX=""
  F  S IDX=$O(^TMP("GMRCR",$J,GMRCFMT,IDX)) Q:'IDX!($G(GMRCQUT))  D
- .I IOSL-$Y<3 D
- ..I $E(IOST,1,2)["C-" D
- ...N DIR S DIR(0)="E" D ^DIR
- ...I 'Y S GMRCQUT=1
- ..Q:$G(GMRCQUT)
- ..D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
- .Q:$G(GMRCQUT)
- .W ^TMP("GMRCR",$J,GMRCFMT,IDX,0),!
- D:$D(^TMP("GMRCR",$J,GMRCFMT)) CAVEATS
+ . I IOSL-$Y<3 D
+ .. I $E(IOST,1,2)["C-" D
+ ... N DIR S DIR(0)="E" D ^DIR
+ ... I 'Y S GMRCQUT=1
+ .. Q:$G(GMRCQUT)
+ .. D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
+ . Q:$G(GMRCQUT)
+ . W ^TMP("GMRCR",$J,GMRCFMT,IDX,0),!
  I GMRCFMT="CP",'$G(GMRCQUT) D
- .Q:$O(^TMP("GMRCT",$J,0,""))=""
- .I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
- .W !!!,$$REPEAT^XLFSTR("-",IOM-5)
- .W !,"Consult services not meeting the criteria of this report for",!,"the specified date range:",!
- .S IDX=""
- .F  S IDX=$O(^TMP("GMRCT",$J,0,IDX)) Q:IDX=""!($G(GMRCQUT))  D
- ..I IOSL-$Y<3 D
- ...I $E(IOST,1,2)["C-" D
- ....N DIR S DIR(0)="E" D ^DIR
- ....I 'Y S GMRCQUT=1
- ...Q:$G(GMRCQUT)
- ...D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
- ..Q:$G(GMRCQUT)
- ..W ?4,IDX,!
+ . Q:$O(^TMP("GMRCTOT",$J,0,""))=""
+ . I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
+ . W !!!,$$REPEAT^XLFSTR("-",IOM-5)
+ . W !,"Consult services with no activity meeting the criteria of this report in",!,"the specified date range:",!
+ . S IDX=""
+ . F  S IDX=$O(^TMP("GMRCTOT",$J,0,IDX)) Q:IDX=""!($G(GMRCQUT))  D
+ .. I IOSL-$Y<3 D
+ ... I $E(IOST,1,2)["C-" D
+ .... N DIR S DIR(0)="E" D ^DIR
+ .... I 'Y S GMRCQUT=1
+ ... Q:$G(GMRCQUT)
+ ... D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
+ .. Q:$G(GMRCQUT)
+ .. W ?4,IDX,!
  D ^%ZISC
  D EXIT
@@ -231 +187 @@
 HEAD(PAGE) ; print header for CPM
  W @IOF
- I PAGE>1 D
- .S TEMP=$S($G(GMRCQTR)=4:"4",$G(GMRCQTR)=3:"3",$G(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$E($G(GMRCFY),3,4)
- .S TEMP="Consult/Request Performance Monitor - "_TEMP
- .W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
- W !,$J("Run Date: "_$$HTE^XLFDT($H),0),$J("Page: "_PAGE,48)
- W !,$$REPEAT^XLFSTR("-",IOM-2),!!
+ W "Consult Performance Monitor",?40,$$HTE^XLFDT($H)
+ W ?73,"Page: ",PAGE,!
+ W $$REPEAT^XLFSTR("-",IOM-2),!
  Q
  ;
-CAVEATS ; brief explanatory text
- W !!,"Resubmitted requests are evaluated based on the original Date of Request."
- W !!,"The following are excluded from this report:"
- W !," -Requests sent to test patients."
- W !," -Requests not marked as Outpatient in the REQUEST/CONSULTATION file."
- W !," -Services flagged as part of the interface between Consults/Request Tracking"
- W !,?2,"and Prosthetics."
- W !," -Administrative requests flagged via the Administrative fields in the"
- W !,?2,"REQUEST SERVICES and REQUEST/CONSULTATION files. This is not retroactive"
- W !,?2,"and only applies to services/requests leveraging the Administrative-flagging"
- W !,?2,"capability included in GMRC*3.0*60, available on or about June 2008.",!!
- Q
- ;
-EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCT" K ^TMP(ARR,$J)
+EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCTOT" K ^TMP(ARR,$J)
  K ARR
  Q