SCRPW51 ;RENO/KEITH - Encounters by DSS Identifier/DSS ID by Frequency (OP0, OP1, OP2) ; 15 Jul 98  02:38PM
 ;;5.3;Scheduling;**144,339,466**;AUG 13, 1993;Build 2
 S SDSTA=$G(SDSTA,2)
 S SDHD1="Encounters by DSS Identifier/DSS ID by Frequency "
 S SDHD1=SDHD1_$S(SDSTA=8:"(IP0, IP1, IP2)",1:"(OP0, OP1, OP2)")
 D RQUE^SCRPW50("START^SCRPW51",SDHD1) Q
 ;
START ;Print report
 K ^TMP("SCRPW",$J) S (SDSTOP,SDOUT)=0,SDT=SD("FYD")
 F  S SDT=$O(^SCE("B",SDT)) Q:'SDT!SDOUT!(SDT>SD("EDT"))  S SDOE=0 F  S SDOE=$O(^SCE("B",SDT,SDOE)) Q:'SDOE!SDOUT  S SDOE0=$$GETOE^SDOE(SDOE),SDIV=$P(SDOE0,U,11) I $$VALID() D SET(SDIV) D:SDMD SET(0)
 G:SDOUT EXIT S (SDVCT,SDIV)=""
 F  S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV=""  D DLIST,STOP Q:SDOUT  D SUB0 S SDSC="" F  S SDSC=$O(^TMP("SCRPW",$J,SDIV,SDSC)) Q:'SDSC!SDOUT  F SDMF="M","F" D SUBT
 G:SDOUT EXIT S SDLINE="",$P(SDLINE,"-",(IOM+1))="" D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDTIT(1)="<*>  ENCOUNTERS BY DSS IDENTIFIER "_$S(SDSTA=8:"(IP0, IP1, IP2)",1:"(OP0, OP1, OP2)")_"  <*>",SDPG=0 D:$E(IOST)="C" DISP0^SCRPW23
 S SDFY=1700+(100*$E(SD("FYD")))+$E(SD("FYD"),2,3)
 I '$D(^TMP("SCRPW",$J)) S SDPAGE=1,SDX="No activity found within report parameters." S SDIV=0 D DHDR^SCRPW40(1,.SDTIT),HDR G:SDOUT EXIT W !!?(IOM-$L(SDX)\2),SDX G EXIT  ;SD*5.3*339 added required input parameters to SCRPW40 call
 G:SDOUT EXIT S SDIVN="" F  S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT  S SDIV=SDIV(SDIVN) D DPRT(.SDIV)
 G:SDOUT EXIT I SDVCT>1 S SDIV=0 D DPRT(.SDIV)
EXIT G EXIT^SCRPW52
 ;
SUB0 F SDMF="M","F" D
 .S (SDCT,DFN)=0 F  S DFN=$O(^TMP("SCRPW",$J,SDIV,SDMF,DFN)) Q:'DFN  S SDCT=SDCT+1
 .S ^TMP("SCRPW",$J,SDIV,SDMF,"UNI")=SDCT Q
 Q
 ;
SUBT S (SDUNI,DFN)=0 F  S DFN=$O(^TMP("SCRPW",$J,SDIV,SDSC,"SEX",SDMF,DFN)) Q:'DFN  S SDUNI=SDUNI+1
 S ^TMP("SCRPW",$J,SDIV,SDSC,"SEX",SDMF,"UNI")=SDUNI
 Q
 ;
DPRT(SDIV) ;Print division
 ;Required input: SDIV=division ifn or '0' for combined divisions
 D DHDR^SCRPW40(2,.SDTIT) S SDTIT(1)="<*>  ENCOUNTERS BY DSS IDENTIFIER "_$S(SDSTA=8:"(IP0, IP1)",1:"(OP0, 0P1)")_"  <*>"
 F SDI=0:1:11 S SDRTOT(SDI)=0
 S SDGTOT=0,SDPAGE=1 D HDR,HD1 Q:SDOUT  S SDSC=0 F  S SDSC=$O(^TMP("SCRPW",$J,SDIV,SDSC)) Q:'SDSC!SDOUT  D PLINE
 Q:SDOUT  W ! F SDI=1:1:132 W "="
 W !,"TOTAL:" F SDYMO=0:1:11 W ?(9+(9*SDYMO)),$J(SDRTOT(SDYMO),7,0)
 W ?117,$J(SDGTOT,15,0)
 D ^SCRPW52
 Q
 ;
PLINE ;Print output line
 Q:'$D(^TMP("SCRPW",$J,SDIV,SDSC,"P"))  N SDYMO
 S SDYMO=0 F  S SDYMO=$O(^TMP("SCRPW",$J,SDIV,SDSC,"P","YMO",SDYMO)) Q:'SDYMO  S SDYMO($$MO())=^TMP("SCRPW",$J,SDIV,SDSC,"P","YMO",SDYMO)
 D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT
 S SDTCT=0 W !?2,SDSC F SDYMO=0:1:11 D
 .S SDCT=+$G(SDYMO(SDYMO)),SDTCT=SDTCT+SDCT,SDRTOT(SDYMO)=SDRTOT(SDYMO)+SDCT,SDGTOT=SDGTOT+SDCT W ?(9+(9*SDYMO)),$J(SDCT,7,0) Q
 W ?117,$J(SDTCT,15,0)
 Q
 ;
MO() ;Determine FY month
 N X S X=+$E(SDYMO,4,5),X=$S(X>9:$E(X,2),1:X+2) Q X
 ;
HDR ;Print header
 I $E(IOST)="C",SDPG N DIR S DIR(0)="E" W ! D ^DIR S SDOUT=Y'=1 Q:SDOUT
 D STOP Q:SDOUT  W:SDPG!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
 N SDI S SDI=0 W SDLINE F  S SDI=$O(SDTIT(SDI)) Q:'SDI  W !?(IOM-$L(SDTIT(SDI))\2),SDTIT(SDI)
 W !,SDLINE,!,"For Fiscal Year activity through ",SD("PEDT"),!,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1,SDPG=1 Q
 ;
HD1 ;Print subheader
 Q:SDOUT  W !,"DSS ID",?9 S SDM1=0 F SDMO=10,11,12,"01","02","03","04","05","06","07","08","09" D
 .W ?(9+(9*SDM1)),SDMO,"/",$S(SDM1<3:SDFY,1:SDFY+1) S SDM1=SDM1+1 Q
 W ?122,"FYTD TOTAL",!,"-------" F SDM1=0:1:11 W ?(9+(9*SDM1)),"-------"
 W ?117,"---------------" Q
 ;
DLIST ;Create alphabetic list of divisions found
 Q:'SDIV  S SDX=$P($G(^DG(40.8,SDIV,0)),U) S:'$L(SDX) SDX="*** UNKNOWN ***" S SDIV(SDX)=SDIV,SDVCT=SDVCT+1 Q
 ;
VALID() ;Check encounter record
 I $P(SDOE0,U,4),$P($G(^SC($P(SDOE0,U,4),0)),U,17)="Y" Q 0
 I SDIV,$$DIV(),$P(SDOE0,U,2),'$P(SDOE0,U,6),$P(SDOE0,U,7),$P(SDOE0,U,12)=SDSTA Q 1
 Q 0
 ;
DIV() ;Check division
 Q:'SDDIV 1  Q $D(SDDIV(SDIV))
 ;
STOP ;Check for stop task request
 S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
 ;
SET(SDIV) ;Set division lists
 ;Required input: SDIV=division ifn or '0' for summary
 S SDSTOP=SDSTOP+1 I SDSTOP#2000=0 D STOP^SCRPW40 Q:SDOUT
 N SDX,SDI,SDPSC,SDSSC
 D SCPC^SCRPW25(.SDX) S SDI=$O(SDX("")),SDPSC=$P(SDX(SDI),U) Q:'SDPSC
 K SDX D SCSC^SCRPW25(.SDX) S SDI=$O(SDX("")),SDSSC=$P(SDX(SDI),U)
 S SDMF=$P($G(^DPT($P(SDOE0,U,2),0)),U,2) I '$L(SDMF)!("MF"'[SDMF) Q
 S SDSCN=$P($G(^DIC(40.7,+SDPSC,0)),U,2) D:SDSCN SET1(SDSCN,"P")
 S SDSCN=$P($G(^DIC(40.7,+SDSSC,0)),U,2) D:SDSCN SET1(SDSCN,"S")
 Q
 ;
SET1(SDC,SDPS) ;Set TMP global
 ;Required input: SDC=stop code AMIS number
 ;Optional input: SDPS='P' or 'S' to indicate primary or secondary
 S ^TMP("SCRPW",$J,SDIV,SDC,SDPS,"ENC")=$G(^TMP("SCRPW",$J,SDIV,SDC,SDPS,"ENC"))+1
 S ^TMP("SCRPW",$J,SDIV,SDC,"SEX",SDMF)=$G(^TMP("SCRPW",$J,SDIV,SDC,"SEX",SDMF))+1
 S ^TMP("SCRPW",$J,SDIV,SDC,"SEX",SDMF,$P(SDOE0,U,2))=""
 S ^TMP("SCRPW",$J,SDIV,SDMF,$P(SDOE0,U,2))="" Q:SDPS="S"
 S ^TMP("SCRPW",$J,SDIV,SDMF,"ENC")=$G(^TMP("SCRPW",$J,SDIV,SDMF,"ENC"))+1
 S ^TMP("SCRPW",$J,SDIV,SDC,SDPS,"YMO",+$E(SDOE0,1,5))=$G(^TMP("SCRPW",$J,SDIV,SDC,SDPS,"YMO",+$E(SDOE0,1,5)))+1 Q