Ignore:
Timestamp:
Dec 4, 2009, 8:26:01 PM (15 years ago)
Author:
George Lilly
Message:

WorldVistAEHR overlayed on FOIAVistA

Location:
FOIAVistA/tag/r
Files:
3 edited
1 copied

Legend:

Unmodified
Added
Removed

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

    r628 r636  
    1 GMRCSTL7 ;SLC/JFR/WAT - DRIVER FOR CSLT PER MONITOR ;4/8/05 10:28
    2  ;;3.0;CONSULT/REQUEST TRACKING;**41,60**;DEC 27, 1997;Build 9
     1GMRCSTL7 ;SLC/JFR - DRIVER FOR CSLT PER MONITOR ;4/8/05 10:28
     2 ;;3.0;CONSULT/REQUEST TRACKING;**41**;DEC 27, 1997
    33 ;
    4  ;This routine invokes ICRs
    5  ;1519(XUTMDEVQ,10103(XLFDT),10104(XLFSTR),3744(VADPT),10089(%ZISC),10026(DIR)
    64 Q
    75 ;
    86EN ; start here
    97 K GMRCQUT
    10  N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
     8 N DIROUT,DTOUT,DUOUT,DIR,DIRUT,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
    119 N GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE
    12  N GMRC30ST,GMRC30SP
    13  D CAVEATS
     10 ;
    1411 ;Ask for service
    15  S DIR(0)="P^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
     12 N Y
     13 S DIR(0)="PO^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
    1614 S DIR("A")="Select Service/Specialty"
    1715 D ^DIR
    18  I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
     16 I Y<1 Q
    1917 S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2)
    20   ;Ask for current FY
    21  N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCFY
    22  S DIR(0)="F^4:4^K:(X-1700)>($E(DT,1,3)+1) X"
    23  S DIR("A")="Current Fiscal Year (i.e. 2008)"
    24  S DIR("A",1)="Ensure you are providing fiscal year, NOT calendar year."
    25  D ^DIR
    26  I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
    27  S GMRCFY=X
    28  N DIROUT,DTOUT,DUOUT,DIR,Y,X,GMRCQTR,GMRCYR
    29  S DIR(0)="N^1:4"
    30  S DIR("A")="Enter a number 1 - 4"
    31  S DIR("A",1)="For which quarter are you running the report: first, second, third or fourth?"
    32  D ^DIR
    33  I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
    34  S GMRCQTR=X
    35  ;if first quarter
    36  I $G(GMRCQTR)=1 D
    37  .;use FY-1 to set year part of date range to the previous calendar year
    38  .S GMRCYR=$G(GMRCFY)-1700 S GMRCYR=$G(GMRCYR)-1,GMRCDT1=$E($G(GMRCYR),1,3)_"1001" S GMRCDT2=$G(GMRCYR)_"1231"
    39  I $G(GMRCQTR)=2 D
    40  .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0101" S GMRCDT2=$G(GMRCYR)_"0331"
    41  I $G(GMRCQTR)=3 D
    42  .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0401" S GMRCDT2=$G(GMRCYR)_"0630"
    43  I $G(GMRCQTR)=4 D
    44  .S GMRCYR=$G(GMRCFY)-1700 S GMRCDT1=$E($G(GMRCYR),1,3)_"0701" S GMRCDT2=$G(GMRCYR)_"0930"
    45  S GMRC30ST=$$FMADD^XLFDT(GMRCDT1,-30),GMRC30SP=$$FMADD^XLFDT(GMRCDT2,-30)
     18 ;
     19 ;Ask for date range
     20 D ^GMRCSPD
     21 I $D(GMRCQUT) G EXIT
     22 ;
    4623 ; what type of report
    47  N DIROUT,DTOUT,DUOUT,DIR,Y,X
     24 K DIR,X,Y
    4825 S DIR(0)="S:O^S:Summary;D:Delimited",DIR("A")="What type of report"
    4926 D ^DIR
    50  I $D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(X="") D EXIT Q
     27 I Y="" G EXIT
    5128 S GMRCFMT=$S(Y="S":"CP",1:"DEL")
    5229 ;
    … …  
    5633 S GMRCSAVE("GMRCDT1")=""
    5734 S GMRCSAVE("GMRCDT2")=""
    58  S GMRCSAVE("GMRC30ST")=""
    59  S GMRCSAVE("GMRC30SP")=""
    6035 S GMRCSAVE("GMRCSVNM")=""
    61  S GMRCSAVE("GMRCFY")=""
    62  S GMRCSAVE("GMRCQTR")=""
    6336 ;
    64  N DIROUT,DTOUT,DUOUT,DIR,Y,X S DIR(0)="FO",DIR("A")="ENTER ""?"" FOR MORE HELP OR RETURN TO CONTINUE"
    65  S DIR("A",1)="MARGIN WIDTH IS BEST AT 256"
    66  S DIR("?")="^D MARGHLP^GMRCSTL7"
    67  D:GMRCFMT="DEL" ^DIR
    68  I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) D EXIT Q
    6937 D EN^XUTMDEVQ("PRNTQ^GMRCSTL7","CONSULT PERFORMANCE MONITOR",.GMRCSAVE)
    7038 ;
    … …  
    7240 ;
    7341 Q
    74 MARGHLP ;help text to set margins
    75  W !,"Specify a device with optional parameters in the format"
    76  W !,?8,"Device Name;Right Margin;Page Length"
    77  W !,?21,"or"
    78  W !,?5,"Device Name;Subtype;Right Margin;Page Length"
    79  W !!,"Or in the new format"
    80  W !,?14,"Device Name;/settings"
    81  W !,?21,"or"
    82  W !,?10,"Device Name;Subtype;/settings"
    83  W !,"For example"
    84  W !,?17,"HOME;80;999"
    85  W !,?21,"or"
    86  W !,?13,"HOME;C-VT320;/M80L999"
    87  Q
    8842 ;
    89 ENOR(RETURN,GMRCSVC,GMRC30ST,GMRC30SP,GMRCSTAT,GMRCST2,GMRCARRN) ;Entry point
     43ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCARRN) ;Entry point
    9044 ;.RETURN:   This is the root to the returned temp array.
    9145 ;GMRCSVC:  Service for which consults are to be displayed.
    92  ;GMRC30ST:  30 days prior to quarter start date
    93  ;GMRC30SP:  30 days prior to quarter end date
     46 ;GMRCDT1:  Starting date or "ALL"
     47 ;GMRCDT2:  Ending date if not GMRCDT1="ALL"
    9448 ;GMRCSTAT: The list of status to include separated by commas
    9549 ;GMRCARRN: Format of report becomes ^TMP array element
    … …  
    11266 D SERV1^GMRCASV
    11367 ;Get external form of date range
     68 I '($D(GMRCDT1)#2) S GMRCDT1="ALL"
     69 S:GMRCDT1="ALL" GMRCDT2=0
    11470 D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
    11571 ;
    116  N GMRCDA,INDEX,STATUS,STATUS2,LOOP,GROUPER
    117  N GMRCSVCG,GMRCPT,GMRCSVCP,GRP,PIECE,TYPE
     72 N GMRCDA,INDEX,STATUS,LOOP,GROUPER
     73 N STS,GMRCD,GMRCDT,GMRCSVCG,TEMP,GMRCPT,LINETEMP
     74 N GMRCPTN,GMRCPTSN,GMRCDLA,GMRCXDT,GMRCLOC,GMRCSVCP
     75 N GRP,GMRCIRF,GMRCIRFN,GMRCIDD,GMRCST,GMRCRDT
    11876 ;
    119  K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCT",$J)
     77 K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J)
    12078 ;
    12179 S GROUPER=0
    … …  
    12381 I GMRCARRN="DEL" D
    12482 . N STR
    125  . S STR="Svc;30DayRng;60DayRng;CmpIn30;Cmp31-60;B4Qtr;PndB4Qtr;%Cmp30;%Cmp60;%UnRsB4Qtr;IS30Rng;IS60Rng;ISCmp30;ISCmp31-60;ISB4Qtr;ISPndB4Qtr;%ISCmp30;%ISCmp60;%ISUnRsB4Qtr;"
    126  . S STR=STR_"IR30Rng;IR60Rng;IRCmp30;IRCmp31-60;IRB4Qtr;IRPndB4Qtr;%IRCmp30;%IRCmp60;%IRUnRsB4Qtr"
     83 . S STR="Service;Total;Unresolved;Complete;Comp w/Results;%Complete;"
     84 . S STR=STR_"%Comp w/Results"
    12785 . S ^TMP("GMRCR",$J,GMRCARRN,1,0)=STR
    12886 S INDEX=""
    … …  
    13290 .S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,INDEX),"^",2)
    13391 .S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)
    134  .N SUBIDX
    135  .;pieces for tmp arrays, 1 to 6 are local, 7 to 12 are IFC placer, 13 to 18 are IFC filler
    136  .;;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
    137  .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"
    138  .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"
    139  .;Check if starting a new Grouper
    140  .F  Q:GROUPER(GROUPER)=GMRCSVCG  D
     92 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0
     93 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=0
     94 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"R")=0
     95 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"C")=0
     96 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"T")=0
     97 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"P")=0
     98 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"R")=0
     99 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"C")=0
     100 . ;Check if starting a new Grouper
     101 . F  Q:GROUPER(GROUPER)=GMRCSVCG  D
    141102 ..;End of a group so print the group totals
    142103 ..I GROUPER(GROUPER)=GMRCSVCG D
    143104 ... I GMRCARRN="CP" D
    144  ....D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
    145  ...I GMRCARRN="DEL" D
    146  ....D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
     105 .... D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
     106 ... I GMRCARRN="DEL" D
     107 .... D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
    147108 ..;pop grouper from stack
    148109 ..S GROUPER=GROUPER-1
    … …  
    153114 .;Loop for one status at a time
    154115 .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
    155  ..D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,GMRC30ST,GMRC30SP,"30")
    156  .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
    157  ..D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,$$FMADD^XLFDT(GMRC30ST,-30),$$FMADD^XLFDT(GMRC30SP,-30),"60")
    158  .S GMRCDT1=$$FMADD^XLFDT(GMRC30ST,30) ;add 30 days back to set date back to start of FY quarter.
    159  .F LOOP=1:1:$L(GMRCST2,",") S STATUS2=$P(GMRCST2,",",LOOP) D
    160  ..D ONESTAT2^GMRCSTL8(GMRCARRN,INDEX,STATUS2,$$FMADD^XLFDT(GMRCDT1,-60))
     116 .. D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,GMRCDT1,GMRCDT2)
    161117 .F GRP=GROUPER:-1:1 D
    162  ..F PIECE=1:1:18 D
    163  ...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)
     118 ..;  pending for this service to all of its groupers
     119 ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"P")
     120 .. ; completed w/results for all groupers
     121 .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"R")
     122 ..;  for all status for this service to all of its groupers
     123 ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"T")
     124 .. ; add all completed for all groupers
     125 .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"C")
    164126 .;
    165127 .;Print the totals for this service that are >0
    166  .I GMRCARRN="CP" D
    167  ..D PRTTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
    168  .I GMRCARRN="DEL" D
    169  ..D DELTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
    170  .Q
     128 . I GMRCARRN="CP" D
     129 .. D PRTTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
     130 . I GMRCARRN="DEL" D
     131 .. D DELTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
     132 . Q
    171133 ;
    172134 ;Done, so now list the group totals for the top group
    173135 ;F GROUPER=GROUPER:-1:1 D  ; left for looking at all totals in future
    174136 I $G(GROUPER) S GROUPER=1 D
    175  .I GMRCARRN="CP" D
    176  ..D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
    177  .I GMRCARRN="DEL" D
    178  ..D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
     137 . I GMRCARRN="CP" D
     138 .. D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
     139 . I GMRCARRN="DEL" D
     140 .. D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
    179141 Q
     142 ;
    180143PRNTQ   ;Build report and print it
    181144 ;
    … …  
    184147 D SERV1^GMRCASV
    185148 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
    186  S TEMP=$S($G(GMRCQTR)=4:"4",$G(GMRCQTR)=3:"3",$G(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$E($G(GMRCFY),3,4)
    187  S TEMP="Consult/Request Performance Monitor - "_TEMP
    188  W $J("",40-($L(TEMP)/2)+.5)_TEMP
    189  S TEMP="Fiscal Quarter Dates: "_$$FMTE^XLFDT(GMRCDT1)_" - "_$$FMTE^XLFDT(GMRCDT2)
    190  W !,$J("",40-($L(TEMP)/2)+.5)_TEMP
    191  S TEMP="30 Days Before Start/End: "_$$FMTE^XLFDT(GMRC30ST)_" - "_$$FMTE^XLFDT(GMRC30SP)
    192  W !,$J("",40-($L(TEMP)/2)+.5)_TEMP
    193  S TEMP="60 Days Before Start/End: "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30ST,-30))_" - "_$$FMTE^XLFDT($$FMADD^XLFDT(GMRC30SP,-30))
     149 W !,$J("",23)_"Consult/Request Performance Monitor"
     150 S TEMP="FROM: "_$$FMTE^XLFDT(GMRCDT1)_"  TO: "_$$FMTE^XLFDT(GMRCDT2)
     151 I GMRCDT1="ALL" S TEMP="ALL DATES"
    194152 W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
    195  I '$D(IO("Q")) D WAIT^DICD W !!
    196153 I '$O(^TMP("GMRCSLIST",$J,0)) D  G EXIT
    197  .W !!,"No records to print"
    198  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)
     154 . W !!,"No records to print"
     155 D ENOR^GMRCSTL7(.GMRCTMP,GMRCDG,GMRCDT1,GMRCDT2,"5,6,8,2,9",GMRCFMT)
    199156 I '$D(^TMP("GMRCR",$J,GMRCFMT)) D
    200  .W !!,"No records to print",!
     157 . W !!,"No records to print",!
    201158 S IDX=""
    202159 F  S IDX=$O(^TMP("GMRCR",$J,GMRCFMT,IDX)) Q:'IDX!($G(GMRCQUT))  D
    203  .I IOSL-$Y<3 D
    204  ..I $E(IOST,1,2)["C-" D
    205  ...N DIR S DIR(0)="E" D ^DIR
    206  ...I 'Y S GMRCQUT=1
    207  ..Q:$G(GMRCQUT)
    208  ..D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
    209  .Q:$G(GMRCQUT)
    210  .W ^TMP("GMRCR",$J,GMRCFMT,IDX,0),!
    211  D:$D(^TMP("GMRCR",$J,GMRCFMT)) CAVEATS
     160 . I IOSL-$Y<3 D
     161 .. I $E(IOST,1,2)["C-" D
     162 ... N DIR S DIR(0)="E" D ^DIR
     163 ... I 'Y S GMRCQUT=1
     164 .. Q:$G(GMRCQUT)
     165 .. D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
     166 . Q:$G(GMRCQUT)
     167 . W ^TMP("GMRCR",$J,GMRCFMT,IDX,0),!
    212168 I GMRCFMT="CP",'$G(GMRCQUT) D
    213  .Q:$O(^TMP("GMRCT",$J,0,""))=""
    214  .I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
    215  .W !!!,$$REPEAT^XLFSTR("-",IOM-5)
    216  .W !,"Consult services not meeting the criteria of this report for",!,"the specified date range:",!
    217  .S IDX=""
    218  .F  S IDX=$O(^TMP("GMRCT",$J,0,IDX)) Q:IDX=""!($G(GMRCQUT))  D
    219  ..I IOSL-$Y<3 D
    220  ...I $E(IOST,1,2)["C-" D
    221  ....N DIR S DIR(0)="E" D ^DIR
    222  ....I 'Y S GMRCQUT=1
    223  ...Q:$G(GMRCQUT)
    224  ...D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
    225  ..Q:$G(GMRCQUT)
    226  ..W ?4,IDX,!
     169 . Q:$O(^TMP("GMRCTOT",$J,0,""))=""
     170 . I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
     171 . W !!!,$$REPEAT^XLFSTR("-",IOM-5)
     172 . W !,"Consult services with no activity meeting the criteria of this report in",!,"the specified date range:",!
     173 . S IDX=""
     174 . F  S IDX=$O(^TMP("GMRCTOT",$J,0,IDX)) Q:IDX=""!($G(GMRCQUT))  D
     175 .. I IOSL-$Y<3 D
     176 ... I $E(IOST,1,2)["C-" D
     177 .... N DIR S DIR(0)="E" D ^DIR
     178 .... I 'Y S GMRCQUT=1
     179 ... Q:$G(GMRCQUT)
     180 ... D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
     181 .. Q:$G(GMRCQUT)
     182 .. W ?4,IDX,!
    227183 D ^%ZISC
    228184 D EXIT
    … …  
    231187HEAD(PAGE) ; print header for CPM
    232188 W @IOF
    233  I PAGE>1 D
    234  .S TEMP=$S($G(GMRCQTR)=4:"4",$G(GMRCQTR)=3:"3",$G(GMRCQTR)=2:"2",1:"1")_"Q"_"FY"_$E($G(GMRCFY),3,4)
    235  .S TEMP="Consult/Request Performance Monitor - "_TEMP
    236  .W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
    237  W !,$J("Run Date: "_$$HTE^XLFDT($H),0),$J("Page: "_PAGE,48)
    238  W !,$$REPEAT^XLFSTR("-",IOM-2),!!
     189 W "Consult Performance Monitor",?40,$$HTE^XLFDT($H)
     190 W ?73,"Page: ",PAGE,!
     191 W $$REPEAT^XLFSTR("-",IOM-2),!
    239192 Q
    240193 ;
    241 CAVEATS ; brief explanatory text
    242  W !!,"Resubmitted requests are evaluated based on the original Date of Request."
    243  W !!,"The following are excluded from this report:"
    244  W !," -Requests sent to test patients."
    245  W !," -Requests not marked as Outpatient in the REQUEST/CONSULTATION file."
    246  W !," -Services flagged as part of the interface between Consults/Request Tracking"
    247  W !,?2,"and Prosthetics."
    248  W !," -Administrative requests flagged via the Administrative fields in the"
    249  W !,?2,"REQUEST SERVICES and REQUEST/CONSULTATION files. This is not retroactive"
    250  W !,?2,"and only applies to services/requests leveraging the Administrative-flagging"
    251  W !,?2,"capability included in GMRC*3.0*60, available on or about June 2008.",!!
    252  Q
    253  ;
    254 EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCT" K ^TMP(ARR,$J)
     194EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCTOT" K ^TMP(ARR,$J)
    255195 K ARR
    256196 Q

  • FOIAVistA/tag/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTL8.m

    r628 r636  
    1 GMRCSTL8 ;SLC/JFR/WAT - Totals format for CPM ; 4/05/05 10:39
    2  ;;3.0;CONSULT/REQUEST TRACKING;**41,60**;DEC 27, 1997;Build 9
    3  ; This routine invokes ICRs
    4  ; 875 (file 100.01), 2638 (file 100.01),10104 (XLFSTR),10103 (XLFDT),3744 (VADPT)
     1GMRCSTL8 ;SLC/JFR - Totals format for CPM ; 4/05/05 10:39
     2 ;;3.0;CONSULT/REQUEST TRACKING;**41**;DEC 27, 1997
     3 ; This routine invokes IA #875, #2638
     4 ; This routine invokes IA #10035,#44, #10040
    55 ;
    66 ; portions copied from GMRCSTL1 & GMRCSTL2
     7 ;
    78 Q  ; can't start here
     9 ;
    810PRTTOT(GEN,INDEX,NAME,ARRN) ; totals for printed report
    9  N QUIT S QUIT=0 D NOACTVT Q:QUIT=1
    10  N GMRCPCT,LAYOUT,FRMT,ROWTEXT,CALC1,CALC2,CALC3,ROWTXT
    11  N COUNT,SVCUSG
     11 N COUNT
    1212 S COUNT=$O(^TMP("GMRCR",$J,ARRN," "),-1)
    1313 I GEN=2 D
    14  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=""
    15  .S SVCUSG=$P(^GMR(123.5,INDEX,0),U,2) I $G(SVCUSG) S NAME=NAME_$S(SVCUSG=1:" <grouper only>",SVCUSG=2:"   <disabled>",1:"")
    16  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="     GROUPER: "_NAME_" Totals:"
    17  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("WITHIN     IFC     IFC",75)
    18  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("FACILITY   SENT    REC'D",77)
     14 . S COUNT=COUNT+1
     15 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)=""
     16 . S COUNT=COUNT+1
     17 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="     GROUPER: "_NAME_" Totals:"
    1918 I GEN=1 D
    20  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=" "
    21  .I $P(^GMR(123.5,INDEX,0),U,2)=9 S NAME=NAME_"   <disabled>"
    22  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="SERVICE: "_NAME
    23  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("WITHIN     IFC      IFC",76)
    24  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=$J("FACILITY   SENT     REC'D",78)
    25  .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U),8)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,7),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,13),9)
    26  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 30 Days Before Start/End of Qtr:"_ROWTXT
    27  .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,2),8)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,8),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,14),9)
    28  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 60 Days Before Start/End of Qtr:"_ROWTXT
    29  I GEN=2 D
    30  .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U),8)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,7),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,13),9)
    31  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 30 Days Before Start/End of Qtr:"_ROWTXT
    32  .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,2),8)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,8),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,14),9)
    33  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests in 60 Days Before Start/End of Qtr:"_ROWTXT
    34  I GEN=1!(GEN=2) D
    35  .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,3),12)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,9),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,15),9)
    36  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="Complete with Results in 30 Days of Request:"_ROWTXT
    37  .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,4),12)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,10),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,16),9)
    38  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="Complete with Results 31-60 Days of Request:"_ROWTXT
    39  .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,5),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,11),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,17),9)
    40  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests Created 60 Days Before Qtr Start:"_ROWTXT
    41  .S ROWTXT=$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,6),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,12),10)_$J($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,18),9)
    42  .S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)="All Requests Pending 60 Days Before Qtr Start:"_ROWTXT
    43  .;% complete in 30 days of request
    44  .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U)>0 S CALC1=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,3)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U))*100,2,2)_"%"
    45  .S ROWTXT=$S($G(CALC1)="":$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC1))_CALC1)
    46  .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,7)>0 S CALC2=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,9)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,7))*100,2,2)_"%"
    47  .S ROWTXT=ROWTXT_$S('$D(CALC2):$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC2))_CALC2)
    48  .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,13)>0 S CALC3=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,15)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,13))*100,2,2)_"%"
    49  .S ROWTXT=ROWTXT_$S($G(CALC3)="":$$REPEAT^XLFSTR(" ",9-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$L(CALC3))_CALC3)
    50  .S COUNT=COUNT+1
    51  .S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percent Complete w/Results in 30 Days of Request: "_ROWTXT
    52  .;% complete in 60 days of request
    53  .K CALC1,CALC2,CALC3
    54  .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,2)>0 S CALC1=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,4)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,2))*100,2,2)_"%"
    55  .S ROWTXT=$S($G(CALC1)="":$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC1))_CALC1)
    56  .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,8)>0 S CALC2=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,10)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,8))*100,2,2)_"%"
    57  .S ROWTXT=ROWTXT_$S('$D(CALC2):$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC2))_CALC2)
    58  .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,14)>0 S CALC3=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,16)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,14))*100,2,2)_"%"
    59  .S ROWTXT=ROWTXT_$S($G(CALC3)="":$$REPEAT^XLFSTR(" ",9-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$L(CALC3))_CALC3)
    60  .S COUNT=COUNT+1
    61  .S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percent Complete w/Results 31-60 Days of Request: "_ROWTXT
    62  .;% pending before quarter start
    63  .K CALC1,CALC2,CALC3
    64  .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,5)>0 S CALC1=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,6)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,5))*100,2,2)_"%"
    65  .S ROWTXT=$S($G(CALC1)="":$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC1))_CALC1)
    66  .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,11)>0 S CALC2=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,12)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,11))*100,2,2)_"%"
    67  .S ROWTXT=ROWTXT_$S('$D(CALC2):$$REPEAT^XLFSTR(" ",10-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",10-$L(CALC2))_CALC2)
    68  .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,17)>0 S CALC3=$J(($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,18)/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,17))*100,2,2)_"%"
    69  .S ROWTXT=ROWTXT_$S($G(CALC3)="":$$REPEAT^XLFSTR(" ",9-$L("N / A"))_"N / A",1:$$REPEAT^XLFSTR(" ",9-$L(CALC3))_CALC3)
    70  .S COUNT=COUNT+1
    71  .S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percent Still Pending Created Before Qtr Start:   "_ROWTXT
     19 . I ^TMP("GMRCTOT",$J,1,INDEX,"T")=0 D  Q  ;collect zero servs for summ
     20 .. Q:$P(^GMR(123.5,INDEX,0),U,2)=1
     21 .. S ^TMP("GMRCTOT",$J,0,NAME)=""
     22 . S COUNT=COUNT+1
     23 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)=" "
     24 . S COUNT=COUNT+1
     25 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="SERVICE: "_NAME
     26 . S COUNT=COUNT+1
     27 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Total Requests To Service:"_$J(^TMP("GMRCTOT",$J,1,INDEX,"T"),30,0)
     28 I GEN=2,^TMP("GMRCTOT",$J,2,INDEX,"T")>0 D
     29 . S COUNT=COUNT+1
     30 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Total Requests To Grouper:"_$J(^TMP("GMRCTOT",$J,2,INDEX,"T"),30,0)
     31 I $G(^TMP("GMRCTOT",$J,GEN,INDEX,"T"))>0 D
     32 . S COUNT=COUNT+1
     33 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Total Requests Pending Resolution: "_$J(^TMP("GMRCTOT",$J,GEN,INDEX,"P"),21,0)
     34 . S COUNT=COUNT+1
     35 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Total Requests completed: "_$J(^TMP("GMRCTOT",$J,GEN,INDEX,"C"),30,0)
     36 . S COUNT=COUNT+1
     37 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Total Requests completed with Results: "_$J(^TMP("GMRCTOT",$J,GEN,INDEX,"R"),17,0)
     38 . N GMRCPCT
     39 . I ^TMP("GMRCTOT",$J,GEN,INDEX,"T")=0 S GMRCPCT="N/A"
     40 . I '$D(GMRCPCT) S GMRCPCT=(^TMP("GMRCTOT",$J,GEN,INDEX,"C")/^TMP("GMRCTOT",$J,GEN,INDEX,"T"))*100
     41 . S COUNT=COUNT+1
     42 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percentage of total requests completed: "_$S(+GMRCPCT'=GMRCPCT:$J(GMRCPCT,16),1:($J(GMRCPCT,19,2)_"%"))
     43 . K GMRCPCT
     44 . I ^TMP("GMRCTOT",$J,GEN,INDEX,"C")=0 S GMRCPCT="N/A"
     45 . I '$D(GMRCPCT) S GMRCPCT=(^TMP("GMRCTOT",$J,GEN,INDEX,"R")/^TMP("GMRCTOT",$J,GEN,INDEX,"C"))*100
     46 . S COUNT=COUNT+1
     47 . S ^TMP("GMRCR",$J,ARRN,COUNT,0)="Percentage of total completed requests with results: "_$S(+GMRCPCT'=GMRCPCT:GMRCPCT,1:($J(GMRCPCT,6,2)_"%"))
    7248 Q
     49 ;
    7350DELTOT(GEN,INDEX,NAME,ARRN) ; format for delimited
    74  N QUIT S QUIT=0 D NOACTVT Q:QUIT=1
    75  N STRING,COUNT,PIECE,INCR,SVCUSG
    76  S SVCUSG=$P(^GMR(123.5,INDEX,0),U,2) I $G(SVCUSG) S NAME=NAME_$S(SVCUSG=1:" <grouper only>",SVCUSG=2:" <disabled>",1:"")
    77  S COUNT=$O(^TMP("GMRCR",$J,ARRN," "),-1),STRING=$S(GEN=2:"GROUPER: ",1:"")_NAME_";"
    78  F PIECE=1:1:18 D
    79  .S STRING=STRING_$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,PIECE)_";"
    80  .I PIECE=6!(PIECE=12)!(PIECE=18) D
    81  ..S INCR=$S(PIECE=6:0,PIECE=12:6,1:12)
    82  ..;percents
    83  ..I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(1+INCR))=0 S STRING=STRING_"N/A;"
    84  ..E  S GMRCPCT=($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(3+INCR))/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(1+INCR)))*100,STRING=STRING_$J(GMRCPCT,0,2)_";"
    85  ..I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(2+INCR))=0 S STRING=STRING_"N/A;"
    86  ..E  S GMRCPCT=($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(4+INCR))/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(2+INCR)))*100,STRING=STRING_$J(GMRCPCT,0,2)_";"
    87  ..I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(5+INCR))=0 S STRING=STRING_"N/A;"
    88  ..E  S GMRCPCT=($P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(6+INCR))/$P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,(5+INCR)))*100,STRING=STRING_$J(GMRCPCT,0,2)_";"
    89  S COUNT=COUNT+1,^TMP("GMRCR",$J,ARRN,COUNT,0)=STRING
     51 ;
     52 I ^TMP("GMRCTOT",$J,GEN,INDEX,"T")=0 Q
     53 N STRING,COUNT
     54 S COUNT=$O(^TMP("GMRCR",$J,ARRN," "),-1)
     55 S STRING=$S(GEN=2:"GROUPER: ",1:"")_NAME_";"
     56 S STRING=STRING_^TMP("GMRCTOT",$J,GEN,INDEX,"T")_";"
     57 S STRING=STRING_^TMP("GMRCTOT",$J,GEN,INDEX,"P")_";"
     58 S STRING=STRING_^TMP("GMRCTOT",$J,GEN,INDEX,"C")_";"
     59 S STRING=STRING_^TMP("GMRCTOT",$J,GEN,INDEX,"R")_";"
     60 D  ;get % completed
     61 . N GMRCPCT
     62 . S GMRCPCT=(^TMP("GMRCTOT",$J,GEN,INDEX,"C")/^TMP("GMRCTOT",$J,GEN,INDEX,"T"))*100
     63 . S STRING=STRING_$J(GMRCPCT,0,2)_";"
     64 . Q
     65 D  ; get % completed w/results
     66 . I ^TMP("GMRCTOT",$J,GEN,INDEX,"C")=0 S STRING=STRING_"N/A;" Q
     67 . N GMRCPCT
     68 . S GMRCPCT=(^TMP("GMRCTOT",$J,GEN,INDEX,"R")/^TMP("GMRCTOT",$J,GEN,INDEX,"C"))*100
     69 . S STRING=STRING_$J(GMRCPCT,0,2)
     70 . Q
     71 S COUNT=COUNT+1
     72 S ^TMP("GMRCR",$J,ARRN,COUNT,0)=STRING
    9073 Q
    91 NOACTVT ;services with no activity for the reporting period
    92  N CONT,PIECE S CONT=1
    93  I GEN=1&($P(^GMR(123.5,INDEX,0),U,2)=1) S QUIT=1 Q  ;;don't add to list if service is a grouper only...
    94  F PIECE=1:1:18 D  Q:CONT=0
    95  .I $P(^TMP("GMRCT",$J,GEN,INDEX,"DATA"),U,PIECE)>0 S CONT=0 Q
    96  S:CONT=1 ^TMP("GMRCT",$J,0,NAME)="",QUIT=1
    97  Q
    98 ONESTAT(ARRN,SVCN,STAT,DT1,DT2,STR) ;Process one status
    99  ;Input -- ARRN  "CP"  - to be printed  or "DEL" - in delimited format
    100  ;SVCN = node in ^TMP("GMRCLIST,$J..STAT = status being worked on..DT1 = starting date..DT2 = ending date
    101  ;STR = string value used to store 30/60 day results in correct piece of ^tmp arrays
    102  ;Output - None
    103  N GMRCPT,GMRCXDT,TEMP,GMRCSVC,GMRCSVCG,GMRCSVCP,GMRCQT,FLG,TYPE
     74 ;
     75ONESTAT(ARRN,SVCN,STAT,DT1,DT2) ;Process one status
     76 ; Input -- ARRN  "CP"  - to be printed
     77 ;                "DEL" - in delimited format
     78 ;          SVCN = node in ^TMP("GMRCLIST,$J
     79 ;          STAT = status being worked on
     80 ;          DT1 = starting date
     81 ;          DT2 = ending date
     82 ;
     83 ; Output - None
     84 ;
     85 N GMRCPT,GMRCXDT,TEMP,GMRCSVC,GMRCSVCG,GMRCSVCP
    10486 S GMRCSVC=$P(^TMP("GMRCSLIST",$J,SVCN),"^",1)
    10587 S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,SVCN),"^",2)
    10688 S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,SVCN),"^",3)
    107  S GMRCXDT=9999999-DT2-.6  ;start searching the global at a date a fraction newer than DT2 (the end date for this search)
     89 S GMRCXDT=$S(DT1="ALL":0,1:9999999-DT2-.6)
    10890 F  S GMRCXDT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT)) Q:GMRCXDT=""!(GMRCXDT>(9999999-DT1))  D
    10991 .S GMRCPT=0
    11092 .;Loop for one consult at a time
    111  .F  S GMRCPT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)) Q:GMRCPT=""  D
    112  ..S FLG=0 D EXCLUDE Q:$G(FLG)=1
    113  ..S TYPE="" D REQTYPE
    114  ..I TYPE="LOCAL" D  ;set totals for 30 and 60 day range
    115  ...S:STR="30" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U)+1
    116  ...S:STR="60" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,2)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,2)+1
    117  ...I STAT=2 D
    118  ....Q:'$O(^GMR(123,+$G(GMRCPT),50,0))  ;Q if no results
    119  ....D CHKRNG
    120  ..I TYPE="IFCP" D
    121  ...S:STR="30" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,7)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,7)+1
    122  ...S:STR="60" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,8)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,8)+1
    123  ...D:STAT=2 CHKRNG
    124  ..I TYPE="IFCF" D
    125  ...S:STR="30" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,13)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,13)+1
    126  ...S:STR="60" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,14)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,14)+1
    127  ...D:STAT=2 CHKRNG
     93 .F  S GMRCPT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)) Q:GMRCPT=""  D
     94 .. N PROS
     95 ..; Check for bad "AE" x-ref
     96 ..I '$D(^GMR(123,GMRCPT,0)) D  Q
     97 ...K ^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)
     98 .. I $$TESTPAT^VADPT(+$P(^GMR(123,GMRCPT,0),U,2)) Q  ; exclude test pats
     99 .. D  I $G(PROS) Q
     100 ... N SVC S SVC=$P(^GMR(123,GMRCPT,0),U,5)
     101 ... I +$G(^GMR(123.5,SVC,"INT")) S PROS=1 ; exclude PROS consults
     102 .. I $P($G(^GMR(123,GMRCPT,12)),U,5)="P" Q  ; exclude IFC placer
     103 ..; Add to totals
     104 ..; for all status for this service
     105 ..S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=^TMP("GMRCTOT",$J,1,GMRCSVC,"T")+1
     106 ..;  pending for this service
     107 ..S:",3,4,5,6,8,9,11,99,"[(","_STAT_",") ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=^TMP("GMRCTOT",$J,1,GMRCSVC,"P")+1
     108 .. I STAT=2 D
     109 ... S ^TMP("GMRCTOT",$J,1,GMRCSVC,"C")=+$G(^TMP("GMRCTOT",$J,1,GMRCSVC,"C"))+1
     110 ... Q:'$O(^GMR(123,+$G(GMRCPT),50,0))  ; Q if no results
     111 ... S ^TMP("GMRCTOT",$J,1,GMRCSVC,"R")=+$G(^TMP("GMRCTOT",$J,1,GMRCSVC,"R"))+1
    128112 Q
    129113 ;
    130 ONESTAT2(ARRN,SVCN,STAT,DT1) ;all statuses, all requests, before quarter start
    131  ;Input -- ARRN  "CP"  - to be printed or "DEL" - in delimited format
    132  ;SVCN = node in ^TMP("GMRCLIST,$J..STAT = status being worked on..DT1 = 60 days before starting date of current quarter
    133  ;Output -- None
    134  N GMRCPT,GMRCXDT,TEMP,GMRCSVC,GMRCSVCG,GMRCSVCP,FLG,TYPE
    135  S GMRCSVC=$P(^TMP("GMRCSLIST",$J,SVCN),"^",1)
    136  S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,SVCN),"^",2)
    137  S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,SVCN),"^",3)
    138  S GMRCXDT=""
    139  F  S GMRCXDT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT)) Q:GMRCXDT=""  D
    140  .S GMRCPT=0
    141  .;Loop for one consult at a time
    142  .F  S GMRCPT=$O(^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)) Q:GMRCPT=""  D
    143  ..Q:GMRCXDT<(9999999-DT1-.6)  ;
    144  ..S FLG=0 D EXCLUDE Q:$G(FLG)=1
    145  ..S TYPE="" D REQTYPE
    146  ..I TYPE="LOCAL" D
    147  ...S $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,5)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,5)+1
    148  ...; get unresolved requests for the period
    149  ...S:",3,4,5,6,8,9,11,99,"[(","_STAT_",") $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,6)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,6)+1
    150  ..I TYPE="IFCP" D
    151  ...S $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,11)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,11)+1
    152  ...S:",3,4,5,6,8,9,11,99,"[(","_STAT_",") $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,12)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,12)+1
    153  ..I TYPE="IFCF" D
    154  ...S $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,17)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,17)+1
    155  ...S:",3,4,5,6,8,9,11,99,"[(","_STAT_",") $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,18)=$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,18)+1
    156  Q
    157 REQTYPE  ;If the request is being requested and performed locally, this field will be blank; Placer done elsewhere, Filler done locally
    158  I $P(^GMR(123,$G(GMRCPT),0),U,23)="" S TYPE="LOCAL" Q
    159  I $P(^GMR(123,$G(GMRCPT),0),U,23)'=""&($P($G(^GMR(123,GMRCPT,12)),U,5)="P") S TYPE="IFCP" Q
    160  I $P(^GMR(123,$G(GMRCPT),0),U,23)'=""&($P($G(^GMR(123,GMRCPT,12)),U,5)="F") S TYPE="IFCF" Q
    161  Q
    162 EXCLUDE ;exclude these request types from the count
    163  N PROS
    164  ; Check for bad "AE" x-ref
    165  I '$D(^GMR(123,GMRCPT,0)) D  S FLG=1 Q
    166  .K ^GMR(123,"AE",GMRCSVC,STAT,GMRCXDT,GMRCPT)
    167  I $$TESTPAT^VADPT(+$P(^GMR(123,GMRCPT,0),U,2)) S FLG=1 Q  ; exclude test pats
    168  D  I $G(PROS) S FLG=1 Q
    169  .N SVC S SVC=$P(^GMR(123,GMRCPT,0),U,5)
    170  .I +$G(^GMR(123.5,SVC,"INT")) S PROS=1 ; exclude PROS consults
    171  I $P($G(^GMR(123,GMRCPT,0)),U,18)'="O" S FLG=1 Q  ; only getting outpat
    172  I $G(^GMR(123,GMRCPT,70))["Y" S FLG=1 Q  ; exclude admin requests
    173  Q
    174 CHKRNG ;check if request is complete within 30/60 days of Desired Date or Date of Request
    175  N DTOR,DTCMPL S DTOR="",DTCMPL=""
    176  Q:'$O(^GMR(123,+$G(GMRCPT),50,0))&('$O(^GMR(123,+$G(GMRCPT),51,0)))
    177  I $D(^GMR(123,+$G(GMRCPT),60))=1 S DTOR=$P(^GMR(123,+$G(GMRCPT),60),U,1) ;check for desired date CPRS GUI v28
    178  S:$G(DTOR)="" DTOR=$P(^GMR(123,+$G(GMRCPT),0),U,7)
    179  ; if request is completed and has results, was it completed within 30 or 60 days of the Date of Request, field 3 in 123 [0;7]
    180  ;order through activity multiple (40) and find the entry for completed 40, [0:2] - value of 10 is complete/update
    181  N CHK S CHK=0
    182  F  S CHK=$O(^GMR(123,+$G(GMRCPT),40,CHK)) Q:CHK="B"  D
    183  .;get the date/time of completion 40, [0;3]
    184  .I $D(^GMR(123,+$G(GMRCPT),40,CHK,0)) S:($P(^GMR(123,GMRCPT,40,CHK,0),U,2)=10) DTCMPL=$P(^GMR(123,GMRCPT,40,CHK,0),U,3)
    185  I $G(DTCMPL) D
    186  .I (STR="30")&(DTCMPL<=$$FMADD^XLFDT(DTOR,30)) D
    187  ..S:TYPE="LOCAL" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,3)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,3)+1
    188  ..S:TYPE="IFCP" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,9)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,9)+1
    189  ..S:TYPE="IFCF" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,15)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,15)+1
    190  .I STR'="30"&(DTCMPL<=$$FMADD^XLFDT(DTOR,60))&(DTCMPL>$$FMADD^XLFDT(DTOR,30)) D
    191  ..S:TYPE="LOCAL" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,4)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,4)+1
    192  ..S:TYPE="IFCP" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,10)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,10)+1
    193  ..S:TYPE="IFCF" $P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,16)=+$P(^TMP("GMRCT",$J,1,GMRCSVC,"DATA"),U,16)+1
    194  Q

  • FOIAVistA/tag/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCYP57.m

    r628 r636  
    1 GMRCYP57 ;BP/WAT - POST INSTALL FOR GMRC*3*57 ;JUL 24, 2007 0830
     1GMRCYP57 ;BP/WAT - POST INSTALL FOR GMRC*3*57 ;10:07 AM  1 Jan 2008
    22 ;;3.0;CONSULT/REQUEST TRACKING;**57**;DEC 27, 1997;Build 10
    33 ;
    … …  
    2222 S ERRMSG(3)="CONFIRM FILE ENTRY AND RE-INSTALL"
    2323 S ERRMSG(4)="IF STILL UNSUCCESSFUL, CONTACT VA NAT'L HELP DESK OR SUBMIT REMEDY TICKET"
    24  S STAIEN=$$LKUP^XUAF4(528) ;return IEN from INSTITUTION file for this station number
     24 S STAIEN=$$LKUP^XUAF4(528)
    2525 I 'STAIEN D BMES^XPDUTL(ERRMSG)
    2626 Q:'STAIEN
Note: See TracChangeset for help on using the changeset viewer.