SDCLAS0 ;ALB/TMP - Clinic Assignment List Select and Extract ; 22 MAR 1985
;;5.3;Scheduling;**32,115,1015**;Aug 13, 1993;Build 21
SELECT W !!,"Do you want the report for active patients only" S %=1 D YN^DICN I %<0 G OUT
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
S SDFAST='(%-1)
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
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"
S X=$$UP^XLFSTR(X)
I X="" S:$P(SDSAV,",",2)']""&($P(SDSAV,",",1)'["--") SDIFN=+SDSAV,SDSAV="" Q
I X="ALL" S SDSAV="",SDIFN="ALL" Q
I X["--" S SDSAV=SDSAV_X_"," G SEL1
LOOK D ^DIC G:Y'>0 SEL1 K DIC("S") S SDSAV=SDSAV_+Y_"," G SEL1
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
LOOK1 S DIC="^DIC(40.7,",DIC(0)="EFMQ" D ^DIC G:Y'>0 SEL1A S SDIFN=+Y
Q
OUT S X="^" Q
EXT S (SDLAST,SDNEXT)="",U="^"
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
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)
I SDACT S ^UTILITY($J,"SDACT",SDIFN)=^UTILITY($J,"SDACT",SDIFN)+1
I 'SDACT S ^UTILITY($J,"SDENR",SDIFN)=^UTILITY($J,"SDENR",SDIFN)+1
K SDACT,Y Q
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
Q
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
Q
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
Q
H1 W !!,"Enter C to select and sort by clinic or S to sort and select by a stop code" Q
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)"
W !,?5,"'ALL' to report all clinics",!,?5,"Hit return when done selecting clinics" G LOOK
H3 W !!,"Enter a stop code or 'All' for all stop codes" G LOOK1
T2 S DFN=A1,Y(1)=^DPT(A1,"DE",A2,1,A3,0),Y(0)=^DPT(A1,0)
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
D EXT Q
SPLIT S SD01=$P(SDZ,"--",1),SD02=$P(SDZ,"--",2) I SD01?1N.N G S1
I $D(^SC("B",SD01)) S X=$O(^SC("B",SD01,0)) S:X>0 SDZ(X)=""
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)=""
K SD01,SD02,II,X,SDI Q
S1 F II=SD01-1:0 S II=$O(^SC(II)) Q:'II!(II>SD02) S SDZ(II)=""
K SD01,SD02,II Q
SDCLAS0 ;ALB/TMP - Clinic Assignment List Select and Extract ; 22 MAR 1985
+1 ;;5.3;Scheduling;**32,115,1015**;Aug 13, 1993;Build 21
SELECT WRITE !!,"Do you want the report for active patients only"
SET %=1
DO YN^DICN
IF %<0
GOTO OUT
+1 IF '%
WRITE !,"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"
GOTO SELECT
+2 SET SDFAST='(%-1)
SELECT1 WRITE !!,"Sort by (C)linic or (S)top Code?: "
READ X:DTIME
IF "^"[X
GOTO OUT
IF X?.E1"?"
DO H1
SET X=$EXTRACT(X,1)
SET X=$$UP^XLFSTR(X)
IF "SC"'[X
GOTO SELECT1
SET SDSRT=X
SET SDSAV=""
IF SDSRT="S"
GOTO SEL1A
SEL1 WRITE !!,"Select Clinic: ",$SELECT(SDSAV']"":"ALL// ",1:"")
READ X:DTIME
IF X["^"
QUIT
IF '$TEST
GOTO OUT
IF X["?"
GOTO H2
IF X=""
IF SDSAV']""
SET X="ALL"
+1 SET X=$$UP^XLFSTR(X)
+2 IF X=""
IF $PIECE(SDSAV,",",2)']""&($PIECE(SDSAV,",",1)'["--")
SET SDIFN=+SDSAV
SET SDSAV=""
QUIT
+3 IF X="ALL"
SET SDSAV=""
SET SDIFN="ALL"
QUIT
+4 IF X["--"
SET SDSAV=SDSAV_X_","
GOTO SEL1
LOOK DO ^DIC
IF Y'>0
GOTO SEL1
KILL DIC("S")
SET SDSAV=SDSAV_+Y_","
GOTO SEL1
SEL1A KILL DIC("S")
WRITE !!,"Select Stop Code: ALL// "
READ X:DTIME
IF X["^"
QUIT
IF '$TEST
GOTO OUT
IF X["?"
GOTO H3
IF X=""
SET SDIFN="ALL"
QUIT
LOOK1 SET DIC="^DIC(40.7,"
SET DIC(0)="EFMQ"
DO ^DIC
IF Y'>0
GOTO SEL1A
SET SDIFN=+Y
+1 QUIT
OUT SET X="^"
QUIT
EXT SET (SDLAST,SDNEXT)=""
SET U="^"
+1 FOR I=0:0
SET I=$ORDER(^DPT(DFN,"S",I))
IF 'I
QUIT
IF $PIECE(^DPT(DFN,"S",I,0),U,2)'["C"
IF $PIECE(^(0),U,2)'["N"
IF +^DPT(DFN,"S",I,0)=SDIFN
IF I'>SDTS
SET SDLAST=I
IF I>SDTS
SET SDNEXT=I
QUIT
+2 SET ^UTILITY($JOB,"S",$EXTRACT($PIECE(^SC(SDIFN,0),U),1,30),SDIFN,$EXTRACT($PIECE(Y(0),U),1,20),DFN)=SDLAST_U_SDNEXT_U_$PIECE(Y(1),U)_U_SDENR_U_SDACT_U_$PIECE(Y(1),U,2)
+3 IF SDACT
SET ^UTILITY($JOB,"SDACT",SDIFN)=^UTILITY($JOB,"SDACT",SDIFN)+1
+4 IF 'SDACT
SET ^UTILITY($JOB,"SDENR",SDIFN)=^UTILITY($JOB,"SDENR",SDIFN)+1
+5 KILL SDACT,Y
QUIT
AEB FOR A=0:0
SET A=$ORDER(^DPT("AEB1",SDIFN,A))
IF 'A!(A>(SDTS_.9))
QUIT
FOR A1=0:0
SET A1=$ORDER(^DPT("AEB1",SDIFN,A,A1))
IF 'A1
QUIT
IF '$DATA(^UTILITY($JOB,"PAT",SDIFN,A1))
IF $DATA(^DPT(A1,0))
IF $SELECT('$DATA(^(.35)):1,'^(.35):1,1:0)
SET (SDENR,SDACT)=0
DO AEB1
+1 QUIT
AEB1 FOR A2=0:0
SET A2=$ORDER(^DPT("AEB1",SDIFN,A,A1,A2))
IF 'A2!($DATA(^UTILITY($JOB,"PAT",A1,SDIFN)))
QUIT
FOR A3=0:0
SET A3=$ORDER(^DPT("AEB1",SDIFN,A,A1,A2,A3))
IF 'A3
QUIT
DO AEB2
+1 QUIT
AEB2 IF $DATA(^DPT(A1,"DE",A2,1,A3,0))
IF +^(0)<(SDTS_.9)
SET X=+$PIECE(^(0),"^",3)
IF X'<SDTS!('X)
SET SDACT=0
SET SDENR=1
DO T2
+1 QUIT
H1 WRITE !!,"Enter C to select and sort by clinic or S to sort and select by a stop code"
QUIT
H2 WRITE !!,"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)"
+1 WRITE !,?5,"'ALL' to report all clinics",!,?5,"Hit return when done selecting clinics"
GOTO LOOK
H3 WRITE !!,"Enter a stop code or 'All' for all stop codes"
GOTO LOOK1
T2 SET DFN=A1
SET Y(1)=^DPT(A1,"DE",A2,1,A3,0)
SET Y(0)=^DPT(A1,0)
+1 DO SET1^SDCLAS
IF '$DATA(^UTILITY($JOB,"PAT"," ",DFN))
DO MT^SDCLAS
SET ^UTILITY($JOB,"PAT"," ",DFN)=$PIECE(Y(0),"^",9)_"^"_SDELIG_"^"_SDZIP_"^"_$PIECE(Y(0),"^",3)_"^"_SDMT
+2 DO EXT
QUIT
SPLIT SET SD01=$PIECE(SDZ,"--",1)
SET SD02=$PIECE(SDZ,"--",2)
IF SD01?1N.N
GOTO S1
+1 IF $DATA(^SC("B",SD01))
SET X=$ORDER(^SC("B",SD01,0))
IF X>0
SET SDZ(X)=""
+2 SET SDI=SD01
FOR II=0:0
SET SDI=$ORDER(^SC("B",SDI))
IF SDI]SD02!(SDI="")
QUIT
SET X=$ORDER(^SC("B",SDI,0))
IF X>0
SET SDZ(X)=""
+3 KILL SD01,SD02,II,X,SDI
QUIT
S1 FOR II=SD01-1:0
SET II=$ORDER(^SC(II))
IF 'II!(II>SD02)
QUIT
SET SDZ(II)=""
+1 KILL SD01,SD02,II
QUIT
