- SDCLAS ;ALB/TMP,MRY - Clinic Assignment List Extract ;12/23/92 11:42
- ;;5.3;Scheduling;**63,243,517,523**;Aug 13, 1993;Build 6
- ;SD/517 CORRECTED ALL $NEXT FUNCTIONAL COMMANDS
- S DIV="" D DIV^SDUTL I $T D CALST^SDDIV Q:Y<0
- S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
- S SDIFN="",SDI=0,DIC="^SC(",DIC(0)="EFMQ",DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS"")),$S(DIV="""":1,$P(^(0),U,15)=DIV:1,1:0)" D SELECT^SDCLAS0 K DIC Q:X["^"
- S Y=DT D DTS^SDUTL S SDTS=Y
- OPT2 W !!,"Select 'As of' Date: ",SDTS," // " R X:DTIME Q:X["^" I X']"" S SDTS=DT G OVR
- S %DT(0)=-DT,%DT="EPX" D ^%DT K %DT
- I Y'>0 W !,*7,"A date must be entered here to get a 'snapshot' of the clinic's enrollment as of",!," this date. Date can not be in future." G OPT2
- S SDTS=+Y
- OVR I SDSRT="C",SDSAV']"",SDIFN'="ALL",$S('$D(^SC(SDIFN,"I")):0,+^("I")=0:0,+^("I")>SDTS:0,+$P(^("I"),"^",2)'>SDTS&(+$P(^("I"),"^",2)'=0):0,1:1) W !,"Clinic ",$S(SDTS=DT:"is",1:"was")," inactive" W:SDTS<DT " on date selected" G END^SDCLAS1
- W !!,*7,"This needs to be printed at 132 columns"
- S PGM="START^SDCLAS",VAR="SDIFN^SDSRT^DIV^SDTS^SDSAV^SDFAST",VAL=SDIFN_"^"_SDSRT_"^"_DIV_"^"_SDTS_"^"_SDSAV_"^"_SDFAST D ZIS^DGUTQ Q:POP
- START K ^UTILITY($J) S SDSTOP=$S(SDSRT="S":SDIFN,1:""),SD1="",U="^" U IO G:SDIFN="ALL"!(SDSRT="S")!(SDSAV]"") ALL
- ONE S ONE=1 D INIT F SDAPPT=SDTS:0 S SDAPPT=$O(^SC(SDIFN,"S",SDAPPT)) Q:SDAPPT'>0 D PT
- D:'SDFAST AEB^SDCLAS0 G ^SDCLAS1
- ALL S ONE=0 I SDSAV']"" S SDIFN=0 F S SDIFN=$O(^SC(SDIFN)) Q:'SDIFN I $P(^(SDIFN,0),"^",3)="C" D APPT
- I SDSAV]"" D APART S SDIFN=0 F S SDIFN=$O(SDZ(SDIFN)) Q:'SDIFN I $D(^SC(SDIFN,0)),$P(^(0),"^",3)="C" D APPT
- G ^SDCLAS1
- APPT D CHECK I 'POP K ^UTILITY($J,"PAT",SDIFN) D INIT F SDAPPT=SDTS:0 S SDAPPT=$O(^SC(SDIFN,"S",SDAPPT)) D:SDAPPT>0 PT I SDAPPT'>0 D:'SDFAST AEB^SDCLAS0 Q
- Q
- PT S SD=0 F S SD=$O(^SC(SDIFN,"S",SDAPPT,1,SD)) Q:'SD Q:'$D(^(SD,0)) S DFN=+^(0) D PT1
- Q
- PT1 I '$D(^UTILITY($J,"PAT",SDIFN,DFN)),$D(^DPT(DFN,0)),$D(^("S",SDAPPT,0)),$P(^(0),"^",2)=""!($P(^(0),"^",2)="I"),$S('$D(^DPT(DFN,.35)):1,'^(.35):1,1:0) D S,EXT^SDCLAS0
- Q
- S S Y(0)=^DPT(DFN,0),SDACT=1,SDENR=0 D SET1
- S I=0 F S I=$O(^DPT(DFN,"DE","B",SDIFN,I)) Q:'I I $D(^DPT(DFN,"DE",I,0)) D EDENR Q:SDENR
- S ^UTILITY($J,"PAT",SDIFN,DFN)="" S:'$D(Y(1))!('SDENR) Y(1)="" I '$D(^UTILITY($J,"PAT"," ",DFN)) D MT S ^UTILITY($J,"PAT"," ",DFN)=$P(Y(0),"^",9)_"^"_SDELIG_"^"_SDZIP_"^"_$P(Y(0),"^",3)_U_SDMT
- Q
- EDENR K Y(1) S I1=0 F S I1=$O(^DPT(DFN,"DE",I,1,I1)) Q:'I1 S X=$P(^(I1,0),"^"),X(1)=$P(^(0),"^",3) Q:X>SDTS S:'X(1)!(X(1)>SDTS) Y(1)=^(0),SDENR=1 Q:SDENR
- Q
- SET1 S SDELIG=$S($D(^DPT(DFN,.36)):$P(^(.36),"^",1),1:""),SDELIG=$S($D(^DIC(8,+SDELIG,0)):SDELIG,1:""),SDELIG(1)=$S(SDELIG]"":$P(^(0),"^",5),1:""),SDZIP=$S($D(^DPT(DFN,.11)):$P(^(.11),"^",6),1:"")
- Q
- MT ;
- S SDMT="*" Q:SDELIG(1)']"" I SDELIG(1)="N" S SDMT="N" Q
- S SDMT=$$LST^DGMTU(DFN) I SDMT']"" S SDMT=$S(SDELIG'=6:"A",1:"X") Q
- S:$P(SDMT,U,2)>SDTS SDMT=$$LST^DGMTU(DFN,SDTS)
- I $P(SDMT,U,4)="P" S SDMT=$$PA^DGMTUTL($P(SDMT,U)),SDMT=$S('$D(SDMT):"U",SDMT="MT":"C",SDMT="GMT":"G",1:"U")
- E S SDMT=$P(SDMT,U,4)
- I SDMT="" S SDMT="X"
- I SDMT="P" S SDMT="C"
- I SDMT="R" S SDMT="U"
- I SDMT="N" S SDMT="A"
- D DOM^SDOPC4(DFN,SDTS_.9,.SDMT) I SDMT="X0" S SDMT="X"
- K SDMT1 Q
- CHECK S POP=0 I SDSRT="S",SDSTOP'="ALL",$P(^SC(SDIFN,0),"^",7)'=SDSTOP S POP=1 Q
- I $S(DIV="":1,$P(^SC(SDIFN,0),"^",15)=DIV:1,1:0),$S('$D(^SC(SDIFN,"I")):1,+^("I")=0:1,+^("I")>DT:1,+$P(^("I"),"^",2)'>DT&(+$P(^("I"),"^",2)'=0):1,1:0) Q
- S POP=1 Q
- APART S SDZ="" F I=1:1 Q:$P(SDSAV,",",I)']"" S SDZ=$P(SDSAV,",",I) D:SDZ["--" SPLIT^SDCLAS0 I SDZ'["--" S:'$D(SDZ(+SDZ)) SDZ(+SDZ)=""
- Q
- INIT F I1="SDENR","SDACT" S I2="^UTILITY("_$J_","""_I1_""","_SDIFN_")",@I2=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCLAS 3744 printed Jan 18, 2025@03:50:09 Page 2
- SDCLAS ;ALB/TMP,MRY - Clinic Assignment List Extract ;12/23/92 11:42
- +1 ;;5.3;Scheduling;**63,243,517,523**;Aug 13, 1993;Build 6
- +2 ;SD/517 CORRECTED ALL $NEXT FUNCTIONAL COMMANDS
- +3 SET DIV=""
- DO DIV^SDUTL
- IF $TEST
- DO CALST^SDDIV
- if Y<0
- QUIT
- +4 if '$DATA(DTIME)
- SET DTIME=300
- IF '$DATA(DT)
- DO DT^SDUTL
- +5 SET SDIFN=""
- SET SDI=0
- SET DIC="^SC("
- SET DIC(0)="EFMQ"
- SET DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS"")),$S(DIV="""":1,$P(^(0),U,15)=DIV:1,1:0)"
- DO SELECT^SDCLAS0
- KILL DIC
- if X["^"
- QUIT
- +6 SET Y=DT
- DO DTS^SDUTL
- SET SDTS=Y
- OPT2 WRITE !!,"Select 'As of' Date: ",SDTS," // "
- READ X:DTIME
- if X["^"
- QUIT
- IF X']""
- SET SDTS=DT
- GOTO OVR
- +1 SET %DT(0)=-DT
- SET %DT="EPX"
- DO ^%DT
- KILL %DT
- +2 IF Y'>0
- WRITE !,*7,"A date must be entered here to get a 'snapshot' of the clinic's enrollment as of",!," this date. Date can not be in future."
- GOTO OPT2
- +3 SET SDTS=+Y
- OVR IF SDSRT="C"
- IF SDSAV']""
- IF SDIFN'="ALL"
- IF $SELECT('$DATA(^SC(SDIFN,"I")):0,+^("I")=0:0,+^("I")>SDTS:0,+$PIECE(^("I"),"^",2)'>SDTS&(+$PIECE(^("I"),"^",2)'=0):0,1:1)
- WRITE !,"Clinic ",$SELECT(SDTS=DT:"is",1:"was")," inactive"
- if SDTS<DT
- WRITE " on date selected"
- GOTO END^SDCLAS1
- +1 WRITE !!,*7,"This needs to be printed at 132 columns"
- +2 SET PGM="START^SDCLAS"
- SET VAR="SDIFN^SDSRT^DIV^SDTS^SDSAV^SDFAST"
- SET VAL=SDIFN_"^"_SDSRT_"^"_DIV_"^"_SDTS_"^"_SDSAV_"^"_SDFAST
- DO ZIS^DGUTQ
- if POP
- QUIT
- START KILL ^UTILITY($JOB)
- SET SDSTOP=$SELECT(SDSRT="S":SDIFN,1:"")
- SET SD1=""
- SET U="^"
- USE IO
- if SDIFN="ALL"!(SDSRT="S")!(SDSAV]"")
- GOTO ALL
- ONE SET ONE=1
- DO INIT
- FOR SDAPPT=SDTS:0
- SET SDAPPT=$ORDER(^SC(SDIFN,"S",SDAPPT))
- if SDAPPT'>0
- QUIT
- DO PT
- +1 if 'SDFAST
- DO AEB^SDCLAS0
- GOTO ^SDCLAS1
- ALL SET ONE=0
- IF SDSAV']""
- SET SDIFN=0
- FOR
- SET SDIFN=$ORDER(^SC(SDIFN))
- if 'SDIFN
- QUIT
- IF $PIECE(^(SDIFN,0),"^",3)="C"
- DO APPT
- +1 IF SDSAV]""
- DO APART
- SET SDIFN=0
- FOR
- SET SDIFN=$ORDER(SDZ(SDIFN))
- if 'SDIFN
- QUIT
- IF $DATA(^SC(SDIFN,0))
- IF $PIECE(^(0),"^",3)="C"
- DO APPT
- +2 GOTO ^SDCLAS1
- APPT DO CHECK
- IF 'POP
- KILL ^UTILITY($JOB,"PAT",SDIFN)
- DO INIT
- FOR SDAPPT=SDTS:0
- SET SDAPPT=$ORDER(^SC(SDIFN,"S",SDAPPT))
- if SDAPPT>0
- DO PT
- IF SDAPPT'>0
- if 'SDFAST
- DO AEB^SDCLAS0
- QUIT
- +1 QUIT
- PT SET SD=0
- FOR
- SET SD=$ORDER(^SC(SDIFN,"S",SDAPPT,1,SD))
- if 'SD
- QUIT
- if '$DATA(^(SD,0))
- QUIT
- SET DFN=+^(0)
- DO PT1
- +1 QUIT
- PT1 IF '$DATA(^UTILITY($JOB,"PAT",SDIFN,DFN))
- IF $DATA(^DPT(DFN,0))
- IF $DATA(^("S",SDAPPT,0))
- IF $PIECE(^(0),"^",2)=""!($PIECE(^(0),"^",2)="I")
- IF $SELECT('$DATA(^DPT(DFN,.35)):1,'^(.35):1,1:0)
- DO S
- DO EXT^SDCLAS0
- +1 QUIT
- S SET Y(0)=^DPT(DFN,0)
- SET SDACT=1
- SET SDENR=0
- DO SET1
- +1 SET I=0
- FOR
- SET I=$ORDER(^DPT(DFN,"DE","B",SDIFN,I))
- if 'I
- QUIT
- IF $DATA(^DPT(DFN,"DE",I,0))
- DO EDENR
- if SDENR
- QUIT
- +2 SET ^UTILITY($JOB,"PAT",SDIFN,DFN)=""
- if '$DATA(Y(1))!('SDENR)
- SET Y(1)=""
- IF '$DATA(^UTILITY($JOB,"PAT"," ",DFN))
- DO MT
- SET ^UTILITY($JOB,"PAT"," ",DFN)=$PIECE(Y(0),"^",9)_"^"_SDELIG_"^"_SDZIP_"^"_$PIECE(Y(0),"^",3)_U_SDMT
- +3 QUIT
- EDENR KILL Y(1)
- SET I1=0
- FOR
- SET I1=$ORDER(^DPT(DFN,"DE",I,1,I1))
- if 'I1
- QUIT
- SET X=$PIECE(^(I1,0),"^")
- SET X(1)=$PIECE(^(0),"^",3)
- if X>SDTS
- QUIT
- if 'X(1)!(X(1)>SDTS)
- SET Y(1)=^(0)
- SET SDENR=1
- if SDENR
- QUIT
- +1 QUIT
- SET1 SET SDELIG=$SELECT($DATA(^DPT(DFN,.36)):$PIECE(^(.36),"^",1),1:"")
- SET SDELIG=$SELECT($DATA(^DIC(8,+SDELIG,0)):SDELIG,1:"")
- SET SDELIG(1)=$SELECT(SDELIG]"":$PIECE(^(0),"^",5),1:"")
- SET SDZIP=$SELECT($DATA(^DPT(DFN,.11)):$PIECE(^(.11),"^",6),1:"")
- +1 QUIT
- MT ;
- +1 SET SDMT="*"
- if SDELIG(1)']""
- QUIT
- IF SDELIG(1)="N"
- SET SDMT="N"
- QUIT
- +2 SET SDMT=$$LST^DGMTU(DFN)
- IF SDMT']""
- SET SDMT=$SELECT(SDELIG'=6:"A",1:"X")
- QUIT
- +3 if $PIECE(SDMT,U,2)>SDTS
- SET SDMT=$$LST^DGMTU(DFN,SDTS)
- +4 IF $PIECE(SDMT,U,4)="P"
- SET SDMT=$$PA^DGMTUTL($PIECE(SDMT,U))
- SET SDMT=$SELECT('$DATA(SDMT):"U",SDMT="MT":"C",SDMT="GMT":"G",1:"U")
- +5 IF '$TEST
- SET SDMT=$PIECE(SDMT,U,4)
- +6 IF SDMT=""
- SET SDMT="X"
- +7 IF SDMT="P"
- SET SDMT="C"
- +8 IF SDMT="R"
- SET SDMT="U"
- +9 IF SDMT="N"
- SET SDMT="A"
- +10 DO DOM^SDOPC4(DFN,SDTS_.9,.SDMT)
- IF SDMT="X0"
- SET SDMT="X"
- +11 KILL SDMT1
- QUIT
- CHECK SET POP=0
- IF SDSRT="S"
- IF SDSTOP'="ALL"
- IF $PIECE(^SC(SDIFN,0),"^",7)'=SDSTOP
- SET POP=1
- QUIT
- +1 IF $SELECT(DIV="":1,$PIECE(^SC(SDIFN,0),"^",15)=DIV:1,1:0)
- IF $SELECT('$DATA(^SC(SDIFN,"I")):1,+^("I")=0:1,+^("I")>DT:1,+$PIECE(^("I"),"^",2)'>DT&(+$PIECE(^("I"),"^",2)'=0):1,1:0)
- QUIT
- +2 SET POP=1
- QUIT
- APART SET SDZ=""
- FOR I=1:1
- if $PIECE(SDSAV,",",I)']""
- QUIT
- SET SDZ=$PIECE(SDSAV,",",I)
- if SDZ["--"
- DO SPLIT^SDCLAS0
- IF SDZ'["--"
- if '$DATA(SDZ(+SDZ))
- SET SDZ(+SDZ)=""
- +1 QUIT
- INIT FOR I1="SDENR","SDACT"
- SET I2="^UTILITY("_$JOB_","""_I1_""","_SDIFN_")"
- SET @I2=0
- +1 QUIT