source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW51.m@ 1357

Last change on this file since 1357 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1SCRPW51 ;RENO/KEITH - Encounters by DSS Identifier/DSS ID by Frequency (OP0, OP1, OP2) ; 15 Jul 98 02:38PM
2 ;;5.3;Scheduling;**144,339,466**;AUG 13, 1993;Build 2
3 S SDSTA=$G(SDSTA,2)
4 S SDHD1="Encounters by DSS Identifier/DSS ID by Frequency "
5 S SDHD1=SDHD1_$S(SDSTA=8:"(IP0, IP1, IP2)",1:"(OP0, OP1, OP2)")
6 D RQUE^SCRPW50("START^SCRPW51",SDHD1) Q
7 ;
8START ;Print report
9 K ^TMP("SCRPW",$J) S (SDSTOP,SDOUT)=0,SDT=SD("FYD")
10 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)
11 G:SDOUT EXIT S (SDVCT,SDIV)=""
12 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
13 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
14 S SDFY=1700+(100*$E(SD("FYD")))+$E(SD("FYD"),2,3)
15 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
16 G:SDOUT EXIT S SDIVN="" F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT S SDIV=SDIV(SDIVN) D DPRT(.SDIV)
17 G:SDOUT EXIT I SDVCT>1 S SDIV=0 D DPRT(.SDIV)
18EXIT G EXIT^SCRPW52
19 ;
20SUB0 F SDMF="M","F" D
21 .S (SDCT,DFN)=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,SDMF,DFN)) Q:'DFN S SDCT=SDCT+1
22 .S ^TMP("SCRPW",$J,SDIV,SDMF,"UNI")=SDCT Q
23 Q
24 ;
25SUBT S (SDUNI,DFN)=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,SDSC,"SEX",SDMF,DFN)) Q:'DFN S SDUNI=SDUNI+1
26 S ^TMP("SCRPW",$J,SDIV,SDSC,"SEX",SDMF,"UNI")=SDUNI
27 Q
28 ;
29DPRT(SDIV) ;Print division
30 ;Required input: SDIV=division ifn or '0' for combined divisions
31 D DHDR^SCRPW40(2,.SDTIT) S SDTIT(1)="<*> ENCOUNTERS BY DSS IDENTIFIER "_$S(SDSTA=8:"(IP0, IP1)",1:"(OP0, 0P1)")_" <*>"
32 F SDI=0:1:11 S SDRTOT(SDI)=0
33 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
34 Q:SDOUT W ! F SDI=1:1:132 W "="
35 W !,"TOTAL:" F SDYMO=0:1:11 W ?(9+(9*SDYMO)),$J(SDRTOT(SDYMO),7,0)
36 W ?117,$J(SDGTOT,15,0)
37 D ^SCRPW52
38 Q
39 ;
40PLINE ;Print output line
41 Q:'$D(^TMP("SCRPW",$J,SDIV,SDSC,"P")) N SDYMO
42 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)
43 D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT
44 S SDTCT=0 W !?2,SDSC F SDYMO=0:1:11 D
45 .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
46 W ?117,$J(SDTCT,15,0)
47 Q
48 ;
49MO() ;Determine FY month
50 N X S X=+$E(SDYMO,4,5),X=$S(X>9:$E(X,2),1:X+2) Q X
51 ;
52HDR ;Print header
53 I $E(IOST)="C",SDPG N DIR S DIR(0)="E" W ! D ^DIR S SDOUT=Y'=1 Q:SDOUT
54 D STOP Q:SDOUT W:SDPG!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
55 N SDI S SDI=0 W SDLINE F S SDI=$O(SDTIT(SDI)) Q:'SDI W !?(IOM-$L(SDTIT(SDI))\2),SDTIT(SDI)
56 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
57 ;
58HD1 ;Print subheader
59 Q:SDOUT W !,"DSS ID",?9 S SDM1=0 F SDMO=10,11,12,"01","02","03","04","05","06","07","08","09" D
60 .W ?(9+(9*SDM1)),SDMO,"/",$S(SDM1<3:SDFY,1:SDFY+1) S SDM1=SDM1+1 Q
61 W ?122,"FYTD TOTAL",!,"-------" F SDM1=0:1:11 W ?(9+(9*SDM1)),"-------"
62 W ?117,"---------------" Q
63 ;
64DLIST ;Create alphabetic list of divisions found
65 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
66 ;
67VALID() ;Check encounter record
68 I $P(SDOE0,U,4),$P($G(^SC($P(SDOE0,U,4),0)),U,17)="Y" Q 0
69 I SDIV,$$DIV(),$P(SDOE0,U,2),'$P(SDOE0,U,6),$P(SDOE0,U,7),$P(SDOE0,U,12)=SDSTA Q 1
70 Q 0
71 ;
72DIV() ;Check division
73 Q:'SDDIV 1 Q $D(SDDIV(SDIV))
74 ;
75STOP ;Check for stop task request
76 S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
77 ;
78SET(SDIV) ;Set division lists
79 ;Required input: SDIV=division ifn or '0' for summary
80 S SDSTOP=SDSTOP+1 I SDSTOP#2000=0 D STOP^SCRPW40 Q:SDOUT
81 N SDX,SDI,SDPSC,SDSSC
82 D SCPC^SCRPW25(.SDX) S SDI=$O(SDX("")),SDPSC=$P(SDX(SDI),U) Q:'SDPSC
83 K SDX D SCSC^SCRPW25(.SDX) S SDI=$O(SDX("")),SDSSC=$P(SDX(SDI),U)
84 S SDMF=$P($G(^DPT($P(SDOE0,U,2),0)),U,2) I '$L(SDMF)!("MF"'[SDMF) Q
85 S SDSCN=$P($G(^DIC(40.7,+SDPSC,0)),U,2) D:SDSCN SET1(SDSCN,"P")
86 S SDSCN=$P($G(^DIC(40.7,+SDSSC,0)),U,2) D:SDSCN SET1(SDSCN,"S")
87 Q
88 ;
89SET1(SDC,SDPS) ;Set TMP global
90 ;Required input: SDC=stop code AMIS number
91 ;Optional input: SDPS='P' or 'S' to indicate primary or secondary
92 S ^TMP("SCRPW",$J,SDIV,SDC,SDPS,"ENC")=$G(^TMP("SCRPW",$J,SDIV,SDC,SDPS,"ENC"))+1
93 S ^TMP("SCRPW",$J,SDIV,SDC,"SEX",SDMF)=$G(^TMP("SCRPW",$J,SDIV,SDC,"SEX",SDMF))+1
94 S ^TMP("SCRPW",$J,SDIV,SDC,"SEX",SDMF,$P(SDOE0,U,2))=""
95 S ^TMP("SCRPW",$J,SDIV,SDMF,$P(SDOE0,U,2))="" Q:SDPS="S"
96 S ^TMP("SCRPW",$J,SDIV,SDMF,"ENC")=$G(^TMP("SCRPW",$J,SDIV,SDMF,"ENC"))+1
97 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
Note: See TracBrowser for help on using the repository browser.