source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDCLAS0.m@ 1679

Last change on this file since 1679 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1SDCLAS0 ;ALB/TMP - Clinic Assignment List Select and Extract ; 22 MAR 1985
2 ;;5.3;Scheduling;**32,115**;Aug 13, 1993
3SELECT W !!,"Do you want the report for active patients only" S %=1 D YN^DICN I %<0 G OUT
4 I '% W !,"Respond (Y)es for a report of only patients with future appointments",!,"Respond (N)o for a report which also includes patients who are enrolled,",!," but have no future appointments" G SELECT
5 S SDFAST='(%-1)
6SELECT1 W !!,"Sort by (C)linic or (S)top Code?: " R X:DTIME G:"^"[X OUT D:X?.E1"?" H1 S X=$E(X,1),X=$$UP^XLFSTR(X) G:"SC"'[X SELECT1 S SDSRT=X,SDSAV="" G:SDSRT="S" SEL1A
7SEL1 W !!,"Select Clinic: ",$S(SDSAV']"":"ALL// ",1:"") R X:DTIME Q:X["^" G:'$T OUT G:X["?" H2 I X="",SDSAV']"" S X="ALL"
8 S X=$$UP^XLFSTR(X)
9 I X="" S:$P(SDSAV,",",2)']""&($P(SDSAV,",",1)'["--") SDIFN=+SDSAV,SDSAV="" Q
10 I X="ALL" S SDSAV="",SDIFN="ALL" Q
11 I X["--" S SDSAV=SDSAV_X_"," G SEL1
12LOOK D ^DIC G:Y'>0 SEL1 K DIC("S") S SDSAV=SDSAV_+Y_"," G SEL1
13SEL1A K DIC("S") W !!,"Select Stop Code: ALL// " R X:DTIME Q:X["^" G:'$T OUT G:X["?" H3 I X="" S SDIFN="ALL" Q
14LOOK1 S DIC="^DIC(40.7,",DIC(0)="EFMQ" D ^DIC G:Y'>0 SEL1A S SDIFN=+Y
15 Q
16OUT S X="^" Q
17EXT S (SDLAST,SDNEXT)="",U="^"
18 F I=0:0 S I=$O(^DPT(DFN,"S",I)) Q:'I I $P(^DPT(DFN,"S",I,0),U,2)'["C",$P(^(0),U,2)'["N",+^DPT(DFN,"S",I,0)=SDIFN S:I'>SDTS SDLAST=I I I>SDTS S SDNEXT=I Q
19 S ^UTILITY($J,"S",$E($P(^SC(SDIFN,0),U),1,30),SDIFN,$E($P(Y(0),U),1,20),DFN)=SDLAST_U_SDNEXT_U_$P(Y(1),U)_U_SDENR_U_SDACT_U_$P(Y(1),U,2)
20 I SDACT S ^UTILITY($J,"SDACT",SDIFN)=^UTILITY($J,"SDACT",SDIFN)+1
21 I 'SDACT S ^UTILITY($J,"SDENR",SDIFN)=^UTILITY($J,"SDENR",SDIFN)+1
22 K SDACT,Y Q
23AEB F A=0:0 S A=$O(^DPT("AEB1",SDIFN,A)) Q:'A!(A>(SDTS_.9)) F A1=0:0 S A1=$O(^DPT("AEB1",SDIFN,A,A1)) Q:'A1 I '$D(^UTILITY($J,"PAT",SDIFN,A1)),$D(^DPT(A1,0)),$S('$D(^(.35)):1,'^(.35):1,1:0) S (SDENR,SDACT)=0 D AEB1
24 Q
25AEB1 F A2=0:0 S A2=$O(^DPT("AEB1",SDIFN,A,A1,A2)) Q:'A2!($D(^UTILITY($J,"PAT",A1,SDIFN))) F A3=0:0 S A3=$O(^DPT("AEB1",SDIFN,A,A1,A2,A3)) Q:'A3 D AEB2
26 Q
27AEB2 I $D(^DPT(A1,"DE",A2,1,A3,0)),+^(0)<(SDTS_.9) S X=+$P(^(0),"^",3) I X'<SDTS!('X) S SDACT=0,SDENR=1 D T2
28 Q
29H1 W !!,"Enter C to select and sort by clinic or S to sort and select by a stop code" Q
30H2 W !!,"Valid responses:",!,?5,"A clinic name or abbreviation",!,?5,"A range of clinics separated by two dashes",!,?10,"(example: GEN MED--GEN MEDZ will report all clinics whose names start GEN MED)"
31 W !,?5,"'ALL' to report all clinics",!,?5,"Hit return when done selecting clinics" G LOOK
32H3 W !!,"Enter a stop code or 'All' for all stop codes" G LOOK1
33T2 S DFN=A1,Y(1)=^DPT(A1,"DE",A2,1,A3,0),Y(0)=^DPT(A1,0)
34 D SET1^SDCLAS I '$D(^UTILITY($J,"PAT"," ",DFN)) D MT^SDCLAS S ^UTILITY($J,"PAT"," ",DFN)=$P(Y(0),"^",9)_"^"_SDELIG_"^"_SDZIP_"^"_$P(Y(0),"^",3)_"^"_SDMT
35 D EXT Q
36SPLIT S SD01=$P(SDZ,"--",1),SD02=$P(SDZ,"--",2) I SD01?1N.N G S1
37 I $D(^SC("B",SD01)) S X=$O(^SC("B",SD01,0)) S:X>0 SDZ(X)=""
38 S SDI=SD01 F II=0:0 S SDI=$O(^SC("B",SDI)) Q:SDI]SD02!(SDI="") S X=$O(^SC("B",SDI,0)) S:X>0 SDZ(X)=""
39 K SD01,SD02,II,X,SDI Q
40S1 F II=SD01-1:0 S II=$O(^SC(II)) Q:'II!(II>SD02) S SDZ(II)=""
41 K SD01,SD02,II Q
Note: See TracBrowser for help on using the repository browser.