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

SCRPW14.m

Go to the documentation of this file. 
  1. SCRPW14 ;RENO/KEITH - Encounter Activity Report ;06/10/99
  1.  ;;5.3;Scheduling;**139,144,180,1015**;AUG 13, 1993;Build 21
  1.  ;06/10/99 ACS Added cpt modifiers to the report
  1.  ;
  1.  N DIC,DIR,DTOUT,DUOUT,X,Y,SD,ZTSAVE,%DT,SDDIV,SDI
  1.  D TITL^SCRPW50("Encounter Activity Report") G:'$$DIVA^SCRPW17(.SDDIV) EXIT
  1.  D SUBT^SCRPW50("*** Date Range Selection ***")
  1. FDT W ! S %DT="AEPX",%DT("A")="Beginning date: ",%DT(0)="-TODAY" D ^%DT G:X=U!$D(DTOUT)!(X="") EXIT
  1.  G:Y<1 FDT S SD("BDT")=Y X ^DD("DD") S SD("PBDT")=Y W !
  1. LDT S %DT("A")="Ending date: " D ^%DT G:X=U!$D(DTOUT)!(X="") EXIT
  1.  I Y<SD("BDT") W !!,$C(7),"Ending date must be after beginning date!",! G LDT
  1.  G:Y<1 LDT S SD("EDT")=Y X ^DD("DD") S SD("PEDT")=Y,SD("EDT")=SD("EDT")_".999999"
  1. CATE D SUBT^SCRPW50("*** Report Category Selection ***")
  1.  W ! S DIR(0)="S^C:CLINIC;P:PROVIDER;S:STOP CODE",DIR("A")="Select category for report output" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("CAT")=Y D STAT G:'$D(SD("STAT")) EXIT
  1.  D SUBT^SCRPW50("*** Report Format Selection ***")
  1.  W ! S DIR(0)="S^D:DETAILED;S:SUMMARY",DIR("A")="Select report format",DIR("B")="SUMMARY" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("FMT")=Y
  1.  I SD("FMT")="S" W ! S DIR(0)="S^A:ALPHABETIC;E:ENCOUNTER TOTALS;V:VISIT TOTALS;U:UNIQUE TOTALS",DIR("A")="Select report order",DIR("B")="ALPHABETIC" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("ORD")=Y G QUE
  1.  S SD("ORD")="A" D LIST(SD("CAT")) G:'$D(SD("LIST")) EXIT
  1. QUE D SUBT^SCRPW50("*** Selected Report Parameters ***")
  1.  W !!,"You have selected the following report parameters:",! D PVIEW^SCRPW15(0)
  1.  W ! K DIR S DIR(0)="Y",DIR("A")="OK",DIR("B")="YES" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT G:'Y EXIT
  1.  F SDI="SDDIV","SDDIV(","SD(","SDL(" S ZTSAVE(SDI)=""
  1.  W ! D EN^XUTMDEVQ("RPT^SCRPW14","OPT. ACTIVITY REPORT",.ZTSAVE)
  1.  ;
  1. EXIT D END^SCRPW50 Q
  1.  ;
  1. STAT ;Prompt for encounter statuses to include
  1.  D SUBT^SCRPW50("*** Encounter Status Selection ***")
  1.  K SD("STAT") W !!,"Choose as many of the following statuses",!,"as you wish to include in the report:",!
  1.  W !?10,"CHECKED IN",!?10,"CHECKED OUT",!?10,"NO ACTION TAKEN",!?10,"INPATIENT APPOINTMENT",!?10,"NON-COUNT",!?10,"ACTION REQUIRED",! N DIC,I S DIC="^SD(409.63,",DIC(0)="AEMQ",DIC("B")="CHECKED OUT"
  1.  S DIC("S")="I Y<4!(Y=8!(Y=12!(Y=14)))",DIC("A")="Select encounter status: " F I=1:1 D ^DIC Q:$D(DTOUT)!$D(DUOUT)  S:Y>0 SD("STAT",$P(Y,U))="" K DIC("B") Q:X=""&(I>1)
  1.  Q
  1.  ;
  1. LIST(X) ;Get list for detail
  1.  ;Output: SD("LIST",ifn)=name
  1.  W ! N DIC S DIC=$S(X="C":"^SC(",X="P":"^VA(200,",1:"^DIC(40.7,"),DIC(0)="AEMQ" S:X="S" DIC("S")="I $L($P(^(0),U,2))=3"
  1.  F  D ^DIC Q:$D(DTOUT)!$D(DUOUT)!(X="")  S:Y>0 SD("LIST",$P(Y,U))=$P(Y,U,2)
  1.  W ! Q
  1.  ;
  1. RPT ;Print report
  1.  N %,X,Y,SDQ,SDTIT,SDI,DFN,SDIVN,SDMD,SDOUT,SDSTOP,SDX
  1.  N SDCH,SDCH0,SDCL,SDCOL,SDD,SDD0,SDDET,SDDT,SDFFS,SDLINE,SDN,SDOE,SDOE0,SDOED,SDOED0,SDP,SDPI,SDP0,SDPAGE,SDPG,SDPNOW,SDPR,SDPT,SDR,SDS,SDSC,SDSV,SDT,SDT1,SDT2,SDTOT,SDTOT1,SDTOT2,SDUN,SDVP,SDVP0,SDVS,SDLIST,SDRPVS,SDRPUN,SDRPEN
  1.  K ^TMP("SCRPW",$J) S (SDOUT,SDSTOP)=0,SDMD=$O(SDDIV("")),SDMD=$O(SDDIV(SDMD)) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDMD=1
  1.  S SDDT=SD("BDT") F  S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SD("EDT"))!SDOUT  S SDOE=0 F  S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE!SDOUT  S SDOE0=$$GETOE^SDOE(SDOE) I $L(SDOE0) S SDIV=$P(SDOE0,U,11) D:SDIV EVAL
  1.  G:SDOUT EXIT G ^SCRPW15
  1.  ;
  1. STOP ;Check for stop task request
  1.  S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
  1.  ;
  1. EVAL ;Evaluate encounter
  1.  S SDSTOP=SDSTOP+1 I SDSTOP#3000=0 D STOP Q:SDOUT
  1.  I '$P(SDOE0,U,6),$$DIV(SDIV),$D(SD("STAT",+$P(SDOE0,U,12))) K SDS I $$CAT(.SDS) D SRT(SDIV) D:SDMD SRT(0) S SDS=0 F  S SDS=$O(SDS(SDS)) Q:'SDS  D SET
  1.  Q
  1.  ;
  1. DIV(SDIV) ;Evaluate division
  1.  Q:'SDDIV 1  Q $D(SDDIV(SDIV))
  1.  ;
  1. SRT(SDIV) ;Set report total for summary format
  1.  Q:SD("FMT")="D"  S SDRPEN(SDIV)=$G(SDRPEN(SDIV))+1,^TMP("SCRPW",$J,SDIV,"RPT","PT",+$P(SDOE0,U,2),+$P(SDDT,"."))="" Q
  1.  ;
  1. SET ;Set global for a division
  1.  D SET1(SDIV) D:SDMD SET1(0) Q:SD("FMT")="S"
  1.  K SDLIST D GETDX^SDOE(SDOE,"SDLIST")
  1.  S SDOED=0 F  S SDOED=$O(SDLIST(SDOED)) Q:'SDOED  S SDOED0=SDLIST(SDOED) D:$L(SDOED0) DSET(SDIV) D:SDMD DSET(0)
  1.  K SDLIST D GETCPT^SDOE(SDOE,"SDLIST")
  1.  S SDVP=0 F  S SDVP=$O(SDLIST(SDVP)) Q:'SDVP  S SDVP0=SDLIST(SDVP) I $L(SDVP0) D PSET(SDIV) D:SDMD PSET(0)
  1.  Q
  1.  ;
  1. SET1(SDIV) S ^TMP("SCRPW",$J,SDIV,1,SDS,"ENC")=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"ENC"))+1,^TMP("SCRPW",$J,SDIV,1,SDS,"PT",+$P(SDOE0,U,2),+$P(SDDT,"."))=""
  1.  Q
  1.  ;
  1. DSET(SDIV) S SDD=+$P(SDOED0,U),SDR=$S($P(SDOED0,U,12)="P":"PRI",1:"SEC"),^TMP("SCRPW",$J,SDIV,1,SDS,"DX",SDD,SDR)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"DX",SDD,SDR))+1 Q
  1.  ;
  1. PSET(SDIV) ;
  1.  I SD("CAT")="P",'$$OLD^SDOEUT(SDOE) S SDPR=$P($G(^AUPNVCPT(SDVP,12)),U,4) Q:'$D(SD("LIST",+SDPR))
  1.  ;S SDP=+$P(SDVP0,U),SDQ=$P(SDVP0,U,16) S:'SDQ SDQ=1 S ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP))+SDQ Q
  1.  ;SDP=procedure pointer, SDQ=procedure quantity
  1.  S SDP=+$P(SDVP0,U)
  1.  S SDQ=$P(SDVP0,U,16)
  1.  S:'SDQ SDQ=1
  1.  ; add quantity to total quantity for current procedure
  1.  S ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP))+SDQ
  1.  ;
  1.  ;Loop through modifiers and add to ^TMP array
  1.  N SDMODN,SDMOD
  1.  S SDMODN=0
  1.  F  S SDMODN=+$O(SDLIST(SDVP,1,SDMODN)) Q:'SDMODN  D
  1.  .S SDMOD=$P(SDLIST(SDVP,1,SDMODN,0),"^")
  1.  .;add modifier quantity to array
  1.  .S:SDMOD ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP,SDMOD)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP,SDMOD))+SDQ
  1.  Q
  1.  ;
  1. CAT(SDS) ;Determine if encounter fits category
  1.  ;Required input: SDS array to return list
  1.  ;Output: SDS(ifn) array=list of category ifns to tally
  1.  I SD("CAT")="C" S SDCL=$P(SDOE0,U,4) Q:SDCL<1 0  S:SD("FMT")="S"!$D(SD("LIST",+SDCL)) SDS(SDCL)="" Q $D(SDS)
  1.  I SD("CAT")="P" D CATP Q $D(SDS)
  1.  I SD("CAT")="S" D CATS Q $D(SDS)
  1.  Q 0
  1.  ;
  1. CATP ;Get providers
  1.  K SDLIST D GETPRV^SDOE(SDOE,"SDLIST")
  1.  S SDPI=0 F  S SDPI=$O(SDLIST(SDPI))  Q:'SDPI  S SDP=$P(SDLIST(SDPI),U) S:SD("FMT")="S"!$D(SD("LIST",SDP)) SDS(SDP)=""
  1.  Q
  1.  ;
  1. CATS ;Get stop codes
  1.  S SDSC=+$P(SDOE0,U,3) S:SD("FMT")="S"!$D(SD("LIST",SDSC)) SDS(SDSC)=""
  1.  S SDCH=0 F  S SDCH=$O(^SCE("APAR",SDOE,SDCH)) Q:'SDCH  S SDCH0=$$GETOE^SDOE(SDCH) I $P(SDCH0,U,8)=4 S SDSC=+$P(SDCH0,U,3) S:SD("FMT")="S"!$D(SD("LIST",SDSC)) SDS(SDSC)=""
  1.  Q