- SDUTL1 ;ALB/MJK - Scheduling Utilities; 12/1/91
- ;;5.3;Scheduling;;Aug 13, 1993
- ;
- ENROL(DFN,SDCL) ;
- S SDY=$$CHK(.DFN,.SDCL,1) G ENROLQ:SDY
- S SDY=$$ASK G ENROLQ:SDY<0
- I SDY=1 S SDY=$$DIE(.DFN,.SDCL) G ENROLQ
- I SDY=0 S SDY=$$CON
- ENROLQ Q SDY
- ;
- CHK(DFN,SDCL,SHOW) ;
- N SDPRCL,CL,SDE,SDJ,DIS,SDY,SDATA
- S SDY=0,SDPRCL=$$PRIN(.SDCL)
- S SDE=0 F S SDE=$O(^DPT(DFN,"DE",SDE)) Q:'SDE S CL=+$G(^(SDE,0)) I CL=SDCL!(CL=SDPRCL) D G CHKQ:SDY
- .S SDJ=0 F S SDJ=$O(^DPT(DFN,"DE",SDE,1,SDJ)) Q:'SDJ S SDATA=$G(^(SDJ,0)) D:$D(SHOW) SHOW(.SDATA) S:'$P(SDATA,U,3) SDY=1
- CHKQ Q SDY
- ;
- ASK() ;
- S DIR(0)="Y",DIR("A")="Do you wish to enroll the patient" D ^DIR K DIR
- S SDY=$S($D(DIRUT):-1,1:Y) K DIRUT
- ASKQ Q SDY
- ;
- CON() ;
- S DIR(0)="Y",DIR("A")="Do you wish to schedule patient for a consult" D ^DIR K DIR
- Q Y
- ;
- DIE(DFN,SDCL) ;
- N SDPRCL,SDFILE,SDE
- S SDPRCL=$$PRIN(.SDCL)
- S SDE=0 F S SDE=$O(^DPT(DFN,"DE",SDE)) Q:'SDE Q:SDPRCL=+$G(^(SDE,0))
- FILE I 'SDE K D0,DD S:'$D(^DPT(DFN,"DE",0)) $P(^DPT(DFN,"DE",0),U,2)=$P(^DD(2,3,0),U,2) S X=SDPRCL,DA(1)=DFN,DIC(0)="L",DIC="^DPT("_DA(1)_",""DE""," D FILE^DICN K DIC,DD,D0 G FILE:Y<1 S SDE=+Y,SDFILE=""
- DATE R !,?10,"DATE OF ENROLLMENT: NOW// ",X:DTIME
- I X["^" D:$D(SDFILE) DIK(.DFN,.SDE) G DIEQ
- S:X="" X="NOW" S %DT="EXT" D ^%DT G:Y<0 DATE
- S:'$D(^DPT(DFN,"DE",SDE,1,0)) $P(^DPT(DFN,"DE",SDE,1,0),U,2)=$P(^DD(2.001,1,0),U,2)
- K DO,DD S X=Y,DA(2)=DFN,DA(1)=SDE,DIC("DR")=1,DIC="^DPT("_DA(2)_",""DE"","_DA(1)_",1,",DIC(0)="L" D FILE^DICN K DIC,DD,D0
- I Y<1,$D(SDFILE) D DIK(.DFN,.SDE)
- K DIK,DA
- DIEQ Q $$CHK(.DFN,.SDCL)
- ;
- DIK(DFN,SDE) ;
- N DA,DIK
- S DA(1)=DFN,DA=SDE,DIK="^DPT("_DA(1)_",""DE""," D ^DIK
- Q
- ;
- PRIN(CLINIC) ;
- N PRIN
- S PRIN=+$P($G(^SC(CLINIC,"SL")),U,5)
- Q $S($D(^SC(PRIN,0)):PRIN,1:CLINIC)
- ;
- SHOW(SDATA) ;
- N SDDIS S SDDIS=$P(SDATA,U,3)
- W !,$S('SDDIS:"Current ",1:"Previous "),"Enrollment: ",$S($P(SDATA,U,2)["O":"OPT",1:"AC")
- I SDDIS W ?41,"Discharged from clinic: ",$$FTIME^VALM1(SDDIS)
- Q
- ;
- TEST ;
- S Y=$$ENROL(1,317)
- W !!,Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDUTL1 2051 printed Feb 19, 2025@00:28:22 Page 2
- SDUTL1 ;ALB/MJK - Scheduling Utilities; 12/1/91
- +1 ;;5.3;Scheduling;;Aug 13, 1993
- +2 ;
- ENROL(DFN,SDCL) ;
- +1 SET SDY=$$CHK(.DFN,.SDCL,1)
- if SDY
- GOTO ENROLQ
- +2 SET SDY=$$ASK
- if SDY<0
- GOTO ENROLQ
- +3 IF SDY=1
- SET SDY=$$DIE(.DFN,.SDCL)
- GOTO ENROLQ
- +4 IF SDY=0
- SET SDY=$$CON
- ENROLQ QUIT SDY
- +1 ;
- CHK(DFN,SDCL,SHOW) ;
- +1 NEW SDPRCL,CL,SDE,SDJ,DIS,SDY,SDATA
- +2 SET SDY=0
- SET SDPRCL=$$PRIN(.SDCL)
- +3 SET SDE=0
- FOR
- SET SDE=$ORDER(^DPT(DFN,"DE",SDE))
- if 'SDE
- QUIT
- SET CL=+$GET(^(SDE,0))
- IF CL=SDCL!(CL=SDPRCL)
- Begin DoDot:1
- +4 SET SDJ=0
- FOR
- SET SDJ=$ORDER(^DPT(DFN,"DE",SDE,1,SDJ))
- if 'SDJ
- QUIT
- SET SDATA=$GET(^(SDJ,0))
- if $DATA(SHOW)
- DO SHOW(.SDATA)
- if '$PIECE(SDATA,U,3)
- SET SDY=1
- End DoDot:1
- if SDY
- GOTO CHKQ
- CHKQ QUIT SDY
- +1 ;
- ASK() ;
- +1 SET DIR(0)="Y"
- SET DIR("A")="Do you wish to enroll the patient"
- DO ^DIR
- KILL DIR
- +2 SET SDY=$SELECT($DATA(DIRUT):-1,1:Y)
- KILL DIRUT
- ASKQ QUIT SDY
- +1 ;
- CON() ;
- +1 SET DIR(0)="Y"
- SET DIR("A")="Do you wish to schedule patient for a consult"
- DO ^DIR
- KILL DIR
- +2 QUIT Y
- +3 ;
- DIE(DFN,SDCL) ;
- +1 NEW SDPRCL,SDFILE,SDE
- +2 SET SDPRCL=$$PRIN(.SDCL)
- +3 SET SDE=0
- FOR
- SET SDE=$ORDER(^DPT(DFN,"DE",SDE))
- if 'SDE
- QUIT
- if SDPRCL=+$GET(^(SDE,0))
- QUIT
- FILE IF 'SDE
- KILL D0,DD
- if '$DATA(^DPT(DFN,"DE",0))
- SET $PIECE(^DPT(DFN,"DE",0),U,2)=$PIECE(^DD(2,3,0),U,2)
- SET X=SDPRCL
- SET DA(1)=DFN
- SET DIC(0)="L"
- SET DIC="^DPT("_DA(1)_",""DE"","
- DO FILE^DICN
- KILL DIC,DD,D0
- if Y<1
- GOTO FILE
- SET SDE=+Y
- SET SDFILE=""
- DATE READ !,?10,"DATE OF ENROLLMENT: NOW// ",X:DTIME
- +1 IF X["^"
- if $DATA(SDFILE)
- DO DIK(.DFN,.SDE)
- GOTO DIEQ
- +2 if X=""
- SET X="NOW"
- SET %DT="EXT"
- DO ^%DT
- if Y<0
- GOTO DATE
- +3 if '$DATA(^DPT(DFN,"DE",SDE,1,0))
- SET $PIECE(^DPT(DFN,"DE",SDE,1,0),U,2)=$PIECE(^DD(2.001,1,0),U,2)
- +4 KILL DO,DD
- SET X=Y
- SET DA(2)=DFN
- SET DA(1)=SDE
- SET DIC("DR")=1
- SET DIC="^DPT("_DA(2)_",""DE"","_DA(1)_",1,"
- SET DIC(0)="L"
- DO FILE^DICN
- KILL DIC,DD,D0
- +5 IF Y<1
- IF $DATA(SDFILE)
- DO DIK(.DFN,.SDE)
- +6 KILL DIK,DA
- DIEQ QUIT $$CHK(.DFN,.SDCL)
- +1 ;
- DIK(DFN,SDE) ;
- +1 NEW DA,DIK
- +2 SET DA(1)=DFN
- SET DA=SDE
- SET DIK="^DPT("_DA(1)_",""DE"","
- DO ^DIK
- +3 QUIT
- +4 ;
- PRIN(CLINIC) ;
- +1 NEW PRIN
- +2 SET PRIN=+$PIECE($GET(^SC(CLINIC,"SL")),U,5)
- +3 QUIT $SELECT($DATA(^SC(PRIN,0)):PRIN,1:CLINIC)
- +4 ;
- SHOW(SDATA) ;
- +1 NEW SDDIS
- SET SDDIS=$PIECE(SDATA,U,3)
- +2 WRITE !,$SELECT('SDDIS:"Current ",1:"Previous "),"Enrollment: ",$SELECT($PIECE(SDATA,U,2)["O":"OPT",1:"AC")
- +3 IF SDDIS
- WRITE ?41,"Discharged from clinic: ",$$FTIME^VALM1(SDDIS)
- +4 QUIT
- +5 ;
- TEST ;
- +1 SET Y=$$ENROL(1,317)
- +2 WRITE !!,Y
