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

SCRPW51.m

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