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

GMRCSTLA.m

Go to the documentation of this file.
  1. GMRCSTLA ;SLC/JFR,WAT - DRIVER FOR LOCAL CSLT COMPL RATE ;
  1. ;;3.0;CONSULT/REQUEST TRACKING;**67,1003**;DEC 27, 1997;Build 14
  1. ;
  1. ;This routine invokes the following ICRs:
  1. ;1519(XUTMDEVQ,10103(XLFDT),10104(XLFSTR),10089(%ZISC),10026(DIR)
  1. Q
  1. ;
  1. EN ; start here
  1. K GMRCQUT
  1. N DIROUT,DTOUT,DUOUT,DIR,DIRUT,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
  1. N GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE,GMRTST
  1. ;
  1. ;Ask for service
  1. N Y
  1. S DIR(0)="PO^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
  1. S DIR("A")="Select Service/Specialty"
  1. D ^DIR
  1. I Y<1 Q
  1. S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2)
  1. ;
  1. ;Ask for date range
  1. D ^GMRCSPD
  1. I $D(GMRCQUT) G EXIT
  1. ;
  1. ;Patch 1003 Check for test patients
  1. S GMRTST=$$TESTPT^GMRCPC1()
  1. I $D(GMRCQUT) S VALMBCK="Q" G EXIT
  1. ; what type of report
  1. K DIR,X,Y
  1. S DIR(0)="S:O^S:Summary;D:Delimited",DIR("A")="What type of report"
  1. D ^DIR
  1. I Y="" G EXIT
  1. S GMRCFMT=$S(Y="S":"CP",1:"DEL")
  1. ;
  1. W @IOF
  1. S GMRCSAVE("GMRCFMT")=""
  1. S GMRCSAVE("GMRCDG")=""
  1. S GMRCSAVE("GMRCDT1")=""
  1. S GMRCSAVE("GMRCDT2")=""
  1. S GMRCSAVE("GMRCSVNM")=""
  1. S GMRCSAVE("GMRTST")=""
  1. ;
  1. D EN^XUTMDEVQ("PRNTQ^GMRCSTLA","LOCAL CONSULT COMPLETION RATES",.GMRCSAVE)
  1. ;
  1. D EXIT
  1. ;
  1. Q
  1. ;
  1. ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCARRN,GMRTST) ;Entry point
  1. ;.RETURN: This is the root to the returned temp array.
  1. ;GMRCSVC: Service for which consults are to be displayed.
  1. ;GMRCDT1: Starting date or "ALL"
  1. ;GMRCDT2: Ending date if not GMRCDT1="ALL"
  1. ;GMRCSTAT: The list of status to include separated by commas
  1. ;GMRCARRN: Format of report becomes ^TMP array element
  1. ; "CP": Summary Report; "DEL": Delimited Report
  1. ;GMRTST: Whether to include test pts or not
  1. ;
  1. ;This temp array is used internally by the report:
  1. ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
  1. ; status is "" tracking and/or grouper
  1. ; 1 grouper only
  1. ; 2 tracking only
  1. ; 9 disabled
  1. ;
  1. N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCGRP,VALMCNT,VALMBCK
  1. K ^TMP("GMRCR",$J,GMRCARRN)
  1. S RETURN="^TMP(""GMRCR"",$J,GMRCARRN)"
  1. I '($D(GMRCSVC)#2) S GMRCSVC=1
  1. Q:'$D(^GMR(123.5,$G(GMRCSVC),0))
  1. ;Build service array
  1. S GMRCDG=GMRCSVC
  1. D SERV1^GMRCASV
  1. ;Get external form of date range
  1. I '($D(GMRCDT1)#2) S GMRCDT1="ALL"
  1. S:GMRCDT1="ALL" GMRCDT2=0
  1. D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
  1. ;
  1. N GMRCDA,INDEX,STATUS,LOOP,GROUPER
  1. N STS,GMRCD,GMRCDT,GMRCSVCG,TEMP,GMRCPT,LINETEMP
  1. N GMRCPTN,GMRCPTSN,GMRCDLA,GMRCXDT,GMRCLOC,GMRCSVCP
  1. N GRP,GMRCIRF,GMRCIRFN,GMRCIDD,GMRCST,GMRCRDT
  1. ;
  1. K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J)
  1. ;
  1. S GROUPER=0
  1. S GROUPER(0)=0
  1. I GMRCARRN="DEL" D
  1. . N STR
  1. . S STR="Service;Total;Unresolved;Complete;Comp w/Results;%Complete;"
  1. . S STR=STR_"%Comp w/Results"
  1. . S ^TMP("GMRCR",$J,GMRCARRN,1,0)=STR
  1. S INDEX=""
  1. ;Loop on Service
  1. F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX="" D
  1. .S GMRCSVC=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
  1. .S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,INDEX),"^",2)
  1. .S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)
  1. .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0
  1. .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=0
  1. .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"R")=0
  1. .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"C")=0
  1. .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"T")=0
  1. .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"P")=0
  1. .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"R")=0
  1. .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"C")=0
  1. . ;Check if starting a new Grouper
  1. . F Q:GROUPER(GROUPER)=GMRCSVCG D
  1. ..;End of a group so print the group totals
  1. ..I GROUPER(GROUPER)=GMRCSVCG D
  1. ... I GMRCARRN="CP" D
  1. .... D PRTTOT^GMRCSTLB(2,GROUPER(GROUPER),GMRCARRN)
  1. ... I GMRCARRN="DEL" D
  1. .... D DELTOT^GMRCSTLB(2,GROUPER(GROUPER),GMRCARRN)
  1. ..;pop grouper from stack
  1. ..S GROUPER=GROUPER-1
  1. .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
  1. ..;push new grouper on stack
  1. ..S GROUPER=GROUPER+1
  1. ..S GROUPER(GROUPER)=GMRCSVC
  1. .;Loop for one status at a time
  1. .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
  1. .. D ONESTAT^GMRCSTLB(GMRCARRN,INDEX,STATUS,GMRCDT1,GMRCDT2)
  1. .F GRP=GROUPER:-1:1 D
  1. ..; pending for this service to all of its groupers
  1. ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"P")
  1. .. ; completed w/results for all groupers
  1. .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"R")
  1. ..; for all status for this service to all of its groupers
  1. ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"T")
  1. .. ; add all completed for all groupers
  1. .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"C")
  1. .;
  1. .;Print the totals for this service that are >0
  1. . I GMRCARRN="CP" D
  1. .. D PRTTOT^GMRCSTLB(1,GMRCSVC,GMRCSVCP,GMRCARRN)
  1. . I GMRCARRN="DEL" D
  1. .. D DELTOT^GMRCSTLB(1,GMRCSVC,GMRCSVCP,GMRCARRN)
  1. . Q
  1. ;
  1. ;Done, so now list the group totals for the top group
  1. ;F GROUPER=GROUPER:-1:1 D ; left for looking at all totals in future
  1. I $G(GROUPER) S GROUPER=1 D
  1. . I GMRCARRN="CP" D
  1. .. D PRTTOT^GMRCSTLB(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
  1. . I GMRCARRN="DEL" D
  1. .. D DELTOT^GMRCSTLB(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
  1. Q
  1. ;
  1. PRNTQ ;Build report and print it
  1. ;
  1. N GMRCPG,GMRCTMP,IDX,GMRCQUT,TEMP
  1. S GMRCPG=1
  1. D SERV1^GMRCASV
  1. D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
  1. W !,$J("",23)_"Local Consult Completion Rates"
  1. S TEMP="FROM: "_$$FMTE^XLFDT(GMRCDT1)_" TO: "_$$FMTE^XLFDT(GMRCDT2)
  1. I GMRCDT1="ALL" S TEMP="ALL DATES"
  1. W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
  1. I '$O(^TMP("GMRCSLIST",$J,0)) D G EXIT
  1. . W !!,"No records to print"
  1. D ENOR^GMRCSTLA(.GMRCTMP,GMRCDG,GMRCDT1,GMRCDT2,"5,6,8,2,9",GMRCFMT,GMRTST)
  1. I '$D(^TMP("GMRCR",$J,GMRCFMT)) D
  1. . W !!,"No records to print",!
  1. S IDX=""
  1. F S IDX=$O(^TMP("GMRCR",$J,GMRCFMT,IDX)) Q:'IDX!($G(GMRCQUT)) D
  1. . I IOSL-$Y<3 D
  1. .. I $E(IOST,1,2)["C-" D
  1. ... N DIR S DIR(0)="E" D ^DIR
  1. ... I 'Y S GMRCQUT=1
  1. .. Q:$G(GMRCQUT)
  1. .. D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
  1. . Q:$G(GMRCQUT)
  1. . W ^TMP("GMRCR",$J,GMRCFMT,IDX,0),!
  1. I GMRCFMT="CP",'$G(GMRCQUT) D
  1. . Q:$O(^TMP("GMRCTOT",$J,0,""))=""
  1. . I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
  1. . W !!!,$$REPEAT^XLFSTR("-",IOM-5)
  1. . W !,"Consult services with no activity meeting the criteria of this report in",!,"the specified date range:",!
  1. . S IDX=""
  1. . F S IDX=$O(^TMP("GMRCTOT",$J,0,IDX)) Q:IDX=""!($G(GMRCQUT)) D
  1. .. I IOSL-$Y<3 D
  1. ... I $E(IOST,1,2)["C-" D
  1. .... N DIR S DIR(0)="E" D ^DIR
  1. .... I 'Y S GMRCQUT=1
  1. ... Q:$G(GMRCQUT)
  1. ... D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
  1. .. Q:$G(GMRCQUT)
  1. .. W ?4,IDX,!
  1. D ^%ZISC
  1. D EXIT
  1. Q
  1. ;
  1. W @IOF
  1. W "Local Consult Completion Rates",?40,$$HTE^XLFDT($H)
  1. W ?73,"Page: ",PAGE,!
  1. W $$REPEAT^XLFSTR("-",IOM-2),!
  1. Q
  1. ;
  1. EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCTOT" K ^TMP(ARR,$J)
  1. K ARR
  1. Q
  1. ;