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

ECRDSSU.m

Go to the documentation of this file. 
  1. ECRDSSU ;ALB/ESD - DSS Unit Workload Summary Report ;11/7/12  12:00
  1.  ;;2.0;EVENT CAPTURE;**5,8,10,14,18,47,63,72,95,119**;8 May 96;Build 12
  1.  ;
  1. EN ;- Get location(s), DSS Unit(s), start & end dates, device
  1.  ;
  1.  N ECLOC,ECDSSU,ECSTDT,ECENDDT
  1.  I '$$ASKLOC^ECRUTL G ENQ
  1.  I '$$ASKDSS^ECRUTL G ENQ
  1.  I '$$STDT^ECRUTL G ENQ
  1.  I '$$ENDDT^ECRUTL(ECSTDT) G ENQ
  1.  I $$ASKDEV D STRPT^ECRDSSU
  1. ENQ Q
  1.  ;
  1.  ;
  1. STRPT ;- Main entry point
  1.  ;
  1.  N ECCRT,ECDSSNM,ECDSSTOT,ECLOCNM,ECQUIT,ECPAGE,ECTMP ;119
  1.  S (ECDSSTOT,ECPAGE,ECQUIT)=0,(ECDSSNM,ECLOCNM)=""
  1.  I $G(ECPTYP)="E" D EXPORT^ECRDSSU2,^ECKILL Q  ;119
  1.  ; Determine if device is CRT
  1.  S ECCRT=$S($E(IOST,1,2)="C-":1,1:0)
  1.  U IO
  1.  D GETREC
  1.  D LOOP
  1.  I ECQUIT G STRPTQ
  1.  D PRTCAT
  1.  I ECQUIT G STRPTQ
  1.  D DSSCHG
  1.  I ECQUIT G STRPTQ
  1.  I $D(ECGUI) G STRPTQ
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  D ^%ZISC
  1. STRPTQ K ^TMP("ECRPT") D ^ECKILL ;119
  1.  Q
  1.  ;
  1.  ;
  1. GETREC ;- Loop thru "ADT" x-ref of EC Patient file (#721)
  1.  ;
  1.  N ECD,ECDFN,ECIEN,ECL,ECNT,I,J,ECREC,ECST
  1.  S ECNT=0
  1.  F I=0:0 S I=$O(ECLOC(I)) Q:'I  S ECL=+$P(ECLOC(I),U) D
  1.  . S ECDFN=0
  1.  . F  S ECDFN=+$O(^ECH("ADT",ECL,ECDFN)) Q:'ECDFN  F J=0:0 S J=$O(ECDSSU(J)) Q:'J  S ECD=+$P(ECDSSU(J),U) D
  1.  .. S ECIEN=0
  1.  .. S ECST=ECSTDT
  1.  .. F  S ECST=+$O(^ECH("ADT",ECL,ECDFN,ECD,ECST)) Q:'ECST!(ECST>ECENDDT)  F  S ECIEN=+$O(^ECH("ADT",ECL,ECDFN,ECD,ECST,ECIEN)) Q:'ECIEN  D
  1.  ... S ECREC=$G(^ECH(ECIEN,0))
  1.  ... I ECD=+$P(ECREC,"^",7) D CRETMP
  1.  Q
  1.  ;
  1.  ;
  1. CRETMP ;- Create ^TMP("ECRPT" array w/format:
  1.  ;    ^TMP("ECRPT",$J,location,DSS Unit,category,count)=procedure^volume^
  1.  ;                                                         CPT modifiers
  1.  ;
  1.  N ECTC,ECTP,ECMOD,ECMODS,ECMODF,SEQ
  1.  S ECTC=$S(+$P(ECREC,"^",8)=0:-1,1:+$P(ECREC,"^",8)),ECTP=$P($G(ECREC),"^",9)
  1.  S ECNT=ECNT+1,ECTP=$P(ECTP,";")_";"_$E($P(ECTP,";",2),1)
  1.  ;ALB/JAM - Get Procedure CPT modifiers
  1.  S ECMODS="" I $O(^ECH(ECIEN,"MOD",0))'="" D
  1.  . K ECMOD S ECMODF=$$MOD^ECUTL(ECIEN,"I",.ECMOD) I 'ECMODF Q
  1.  . S SEQ="" F  S SEQ=$O(ECMOD(SEQ)) Q:SEQ=""  D
  1.  . . S ECMODS=ECMODS_$S(ECMODS="":"",1:";")_SEQ
  1.  S ^TMP("ECRPT",$J,+$P(ECREC,"^",4),+$P(ECREC,"^",7),ECTC,ECNT)=ECTP_"^"_+$P(ECREC,"^",10)_"^"_ECMODS
  1.  Q
  1.  ;
  1. LOOP ;- Loop through data
  1.  ;
  1.  N ECCAT,ECNT,ECOCAT,ECDSS,ECLOCAT,ECPR,ECVOL,ECMOD
  1.  S (ECNT,ECDSS,ECLOCAT)=0,(ECCAT,ECOCAT)=""
  1.  I '$D(^TMP("ECRPT",$J)) G LOOPQ
  1.  F  S ECLOCAT=$O(^TMP("ECRPT",$J,ECLOCAT)) Q:'ECLOCAT  D
  1.  . F  S ECDSS=$O(^TMP("ECRPT",$J,ECLOCAT,ECDSS)) Q:'ECDSS  D
  1.  .. Q:ECQUIT
  1.  .. D PRTCAT Q:ECQUIT
  1.  .. D DSSCHG Q:ECQUIT
  1.  .. S ECOCAT=0
  1.  .. D HDR
  1.  .. D LOCNAM,DSSUNAM
  1.  .. W !!,"Location: ",$G(ECLOCNM),!,"DSS Unit: ",$G(ECDSSNM)
  1.  .. F  S ECCAT=$O(^TMP("ECRPT",$J,ECLOCAT,ECDSS,ECCAT)) Q:ECCAT=""  D
  1.  ... D CATCHG
  1.  ... Q:ECQUIT
  1.  ... F  S ECNT=$O(^TMP("ECRPT",$J,ECLOCAT,ECDSS,ECCAT,ECNT)) Q:'ECNT  D
  1.  .... S (ECPR,ECVOL)=0
  1.  .... S ECPR=$P($G(^TMP("ECRPT",$J,ECLOCAT,ECDSS,ECCAT,ECNT)),"^")
  1.  .... S ECVOL=$P($G(^TMP("ECRPT",$J,ECLOCAT,ECDSS,ECCAT,ECNT)),"^",2)
  1.  .... S ECMOD=$P($G(^TMP("ECRPT",$J,ECLOCAT,ECDSS,ECCAT,ECNT)),"^",3)
  1.  .... I '$D(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)) S ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)=ECVOL D:ECMOD'="" SETMOD Q
  1.  .... S ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)=ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR)+ECVOL D:ECMOD'="" SETMOD
  1. LOOPQ Q
  1. SETMOD ;ALB/JAM - Set CPT modifiers in ECTMP array
  1.  N MOD,I
  1.  F I=1:1 S MOD=$P(ECMOD,";",I) Q:MOD=""  D
  1.  . S ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR,MOD)=$G(ECTMP(ECLOCAT,ECDSS,ECCAT,ECPR,MOD))+ECVOL
  1.  Q
  1.  ;
  1. CATCHG ;- Category change
  1.  ;
  1.  I ECCAT=""&(ECOCAT="") G CATCHGQ
  1.  I ECOCAT="" S ECOCAT=ECCAT G CATCHGQ
  1.  I $G(ECOCAT)'=$G(ECCAT) D
  1.  . D PRTCAT
  1.  . S ECOCAT=ECCAT
  1. CATCHGQ Q
  1.  ;
  1. PRTCAT ;- Print category
  1.  ;
  1.  Q:'$D(ECTMP)
  1.  N ECC,ECCATOT,ECDSS,ECFLG,ECLOC,ECPR,ECPRN,ECSYI,ECSYN,ECCNAM,ECPNAM
  1.  N ECCPT,ECPI
  1.  S (ECCATOT,ECDSS,ECFLG,ECLOC)=0,(ECC,ECCNAM,ECPR)=""
  1.  F  S ECLOC=$O(ECTMP(ECLOC)) Q:'ECLOC  F  S ECDSS=$O(ECTMP(ECLOC,ECDSS)) Q:'ECDSS  F  S ECC=$O(ECTMP(ECLOC,ECDSS,ECC)) Q:ECC=""  F  S ECPR=$O(ECTMP(ECLOC,ECDSS,ECC,ECPR)) Q:ECPR=""  D  I ECQUIT Q
  1.  . S ECCNAM=$S($P($G(^EC(726,$S(ECC<1:0,1:+ECC),0)),"^")'="":$P($G(^EC(726,$S(ECC<1:0,1:+ECC),0)),"^"),1:"None")
  1.  . S ECPRN=$S($P(ECPR,";",2)="E":ECPR_"C(725,",1:ECPR_"CPT(")
  1.  . S ECSYI=+$O(^ECJ("AP",ECLOC,ECDSS,$S(ECC<1:0,1:+ECC),ECPRN,0)),ECSYN=$P($G(^ECJ(ECSYI,"PRO")),"^",2)
  1.  . S ECPI=""
  1.  . S ECCPT=$S($P(ECPR,";",2)="I":+ECPR,1:$P($G(^EC(725,+ECPR,0)),"^",5))
  1.  . I ECCPT'="" S ECPI=$$CPT^ICPTCOD(ECCPT,$P(ECENDDT,".")),ECCPT=$P(ECPI,"^",2)
  1.  . S ECPNAM=$S($P(ECPR,";",2)="E":$G(^EC(725,+$P(ECPR,";"),0)),$P(ECPR,";",2)="I":$P(ECPI,"^",3),1:"") S:$P(ECPR,";",2)="E" ECPNAM=$P(ECPNAM,"^",2)_" "_$P(ECPNAM,"^")
  1.  . Q:ECQUIT
  1.  . I $Y>(IOSL-11) D PAUSE Q:ECQUIT  D HDR
  1.  . W:'ECFLG !!?1,"Category:",!?2,ECCNAM S ECFLG=1
  1.  . W !?3,ECCPT,?9,$E(ECPNAM,1,35),?46,$S(ECSYN]"":$E(ECSYN,1,21),1:""),?69,$J($P($G(ECTMP(ECLOC,ECDSS,ECC,ECPR)),"^"),6)
  1.  . S ECCATOT=ECCATOT+$P($G(ECTMP(ECLOC,ECDSS,ECC,ECPR)),"^")
  1.  . I $O(ECTMP(ECLOC,ECDSS,ECC,ECPR,""))'="" D PRTMOD I ECQUIT Q
  1.  G:ECQUIT PRTCATQ
  1.  I $Y>(IOSL-11) D PAUSE G:ECQUIT PRTCATQ D HDR
  1.  W !?69,"------"
  1.  W !?6,"Total Procedures for ",ECCNAM,?69,$J(ECCATOT,6),!
  1.  S ECDSSTOT=ECDSSTOT+ECCATOT
  1. PRTCATQ K ECTMP
  1.  Q
  1.  ;
  1. PRTMOD ;ALB/JAM - Print CPT modifiers
  1.  N MOD,IEN,MODESC,MODI S IEN=""
  1.  F  S IEN=$O(ECTMP(ECLOC,ECDSS,ECC,ECPR,IEN)) Q:IEN=""  D
  1.  . I $Y>(IOSL-8) D PAUSE Q:ECQUIT  D HDR
  1.  . S MODI=$$MOD^ICPTMOD(IEN,"I",$P(ECENDDT,"."))
  1.  . S MOD=$P(MODI,"^",2) I MOD="" Q
  1.  . S MODESC=$P(MODI,"^",3) I MODESC="" S MODESC="Unknown"
  1.  . W !?7,"- ",MOD," ",$E(MODESC,1,40)," ("
  1.  . W ECTMP(ECLOC,ECDSS,ECC,ECPR,IEN),")"
  1.  Q
  1.  ;
  1. DSSCHG ;- DSS Unit change
  1.  ;
  1.  Q:'$G(ECDSSTOT)
  1.  I ECDSSTOT>0 D
  1.  . I $Y>(IOSL-11) D PAUSE Q:ECQUIT  D HDR
  1.  . W !!?69,"======"
  1.  . W !?6,"Total Procedures for ",$G(ECDSSNM),?69,$J(ECDSSTOT,6)
  1.  . S ECDSSTOT=0,(ECLOCNM,ECDSSNM)=""
  1.  . D PAUSE
  1.  Q
  1.  ;
  1. HDR ;- Report header
  1.  ;
  1.  I ECCRT!(ECPAGE) W @IOF
  1.  S ECPAGE=ECPAGE+1
  1.  W !,?((IOM-32)\2),"DSS UNIT WORKLOAD SUMMARY REPORT"
  1.  W !,?((IOM-40)\2),"Date Range: "_$$FMTE^XLFDT($P((ECSTDT+.0001),"."))_" to "_$$FMTE^XLFDT($P(ECENDDT,"."))
  1.  W !!,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
  1.  W ?65,"    Page: ",ECPAGE
  1.  W !!?3,"CPT Code",?13,"Description",?46,"Synonym",?69,"Volume"
  1.  W !?7,"CPT Modifier (volume of modifiers use)"
  1.  W !,$TR($J("",79)," ","-")
  1.  Q
  1.  ;
  1.  ;
  1. LOCNAM ;- Get location name
  1.  ;
  1.  N I
  1.  F I=0:0 S I=$O(ECLOC(I)) Q:'I  I $P($G(ECLOC(I)),"^")=ECLOCAT S ECLOCNM=$P(ECLOC(I),"^",2)
  1.  Q
  1.  ;
  1.  ;
  1. DSSUNAM ;- Get DSS Unit name
  1.  ;
  1.  N I
  1.  F I=0:0 S I=$O(ECDSSU(I)) Q:'I  I $P($G(ECDSSU(I)),"^")=ECDSS S ECDSSNM=$P(ECDSSU(I),"^",2)
  1.  Q
  1.  ;
  1.  ;
  1. PAUSE ;- Pause for screen output
  1.  D FOOTER
  1.  Q:'ECCRT
  1.  N DIR,DIRUT,DUOUT
  1.  I IOSL<30 F  W ! Q:$Y>(IOSL-4)
  1.  W ! S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S ECQUIT=1
  1.  Q
  1.  ;
  1.  ;
  1.  W !!?4,"Volume totals may represent days, minutes, numbers of procedures"
  1.  W !?4,"and/or a combination of these."
  1.  Q
  1.  ;
  1.  ;
  1. ASKDEV() ;- Ask device for printing or queuing report
  1.  ;  Input:     None
  1.  ;
  1.  ; Output:     1 if report is printed
  1.  ;             0 if report is queued (or exited out)
  1.  ;
  1.  N ECX,ZTDESC,ZTRTN,ZTSAVE
  1.  S ECX=1
  1.  K %ZIS S %ZIS="QMP"
  1.  D ^%ZIS
  1.  S:POP ECX=0
  1.  I ECX&($D(IO("Q"))) D
  1.  . S ZTRTN="STRPT^ECRDSSU",ZTDESC="DSS UNIT WORKLOAD SUMMARY REPORT"
  1.  . S (ZTSAVE("ECLOC("),ZTSAVE("ECDSSU("),ZTSAVE("ECSTDT"),ZTSAVE("ECENDDT"))=""
  1.  . D ^%ZTLOAD
  1.  . D HOME^%ZIS
  1.  . S ECX=0
  1.  Q ECX