| [613] | 1 | SDCLAS0 ;ALB/TMP - Clinic Assignment List Select and Extract ; 22 MAR 1985
|
|---|
| 2 | ;;5.3;Scheduling;**32,115**;Aug 13, 1993
|
|---|
| 3 | SELECT 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)
|
|---|
| 6 | SELECT1 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
|
|---|
| 7 | SEL1 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
|
|---|
| 12 | LOOK D ^DIC G:Y'>0 SEL1 K DIC("S") S SDSAV=SDSAV_+Y_"," G SEL1
|
|---|
| 13 | SEL1A 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
|
|---|
| 14 | LOOK1 S DIC="^DIC(40.7,",DIC(0)="EFMQ" D ^DIC G:Y'>0 SEL1A S SDIFN=+Y
|
|---|
| 15 | Q
|
|---|
| 16 | OUT S X="^" Q
|
|---|
| 17 | EXT 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
|
|---|
| 23 | AEB 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
|
|---|
| 25 | AEB1 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
|
|---|
| 27 | AEB2 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
|
|---|
| 29 | H1 W !!,"Enter C to select and sort by clinic or S to sort and select by a stop code" Q
|
|---|
| 30 | H2 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
|
|---|
| 32 | H3 W !!,"Enter a stop code or 'All' for all stop codes" G LOOK1
|
|---|
| 33 | T2 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
|
|---|
| 36 | SPLIT 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
|
|---|
| 40 | S1 F II=SD01-1:0 S II=$O(^SC(II)) Q:'II!(II>SD02) S SDZ(II)=""
|
|---|
| 41 | K SD01,SD02,II Q
|
|---|
