SDUTL1 ;ALB/MJK - Scheduling Utilities; 12/1/91
;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21
;IHS/ANMC/LJF 6/23/2000 automatically enroll IHS patients
; answer date as NOW and type as OPT
; 7/06/2000 removed display of enrollment status
;
;
ENROL(DFN,SDCL) ;
S SDY=$$CHK(.DFN,.SDCL,1) G ENROLQ:SDY
;S SDY=$$ASK G ENROLQ:SDY<0 ;IHS/ANMC/LJF 6/23/2000
S SDY=1 ;IHS/ANMC/LJF 6/23/2000
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 ;IHS/ANMC/LJF 6/23/2000
;I X["^" D:$D(SDFILE) DIK(.DFN,.SDE) G DIEQ ;IHS/ANMC/LJF 6/23/2000
;S:X="" X="NOW" S %DT="EXT" D ^%DT G:Y<0 DATE ;IHS/ANMC/LJF 6/23/2000
S X="NOW" S %DT="EXT" D ^%DT G:Y<0 DATE ;IHS/ANMC/LJF 6/23/2000
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
K DO,DD S X=Y,DA(2)=DFN,DA(1)=SDE,DIC("DR")="1///O",DIC="^DPT("_DA(2)_",""DE"","_DA(1)_",1,",DIC(0)="L" D FILE^DICN K DIC,DD,D0 ;IHS/ANMC/LJF 6/23/2000
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
SDUTL1 ;ALB/MJK - Scheduling Utilities; 12/1/91
+1 ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 6/23/2000 automatically enroll IHS patients
+3 ; answer date as NOW and type as OPT
+4 ; 7/06/2000 removed display of enrollment status
+5 ;
+6 ;
ENROL(DFN,SDCL) ;
+1 SET SDY=$$CHK(.DFN,.SDCL,1)
IF SDY
GOTO ENROLQ
+2 ;S SDY=$$ASK G ENROLQ:SDY<0 ;IHS/ANMC/LJF 6/23/2000
+3 ;IHS/ANMC/LJF 6/23/2000
SET SDY=1
+4 IF SDY=1
SET SDY=$$DIE(.DFN,.SDCL)
GOTO ENROLQ
+5 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 ;R !,?10,"DATE OF ENROLLMENT: NOW// ",X:DTIME ;IHS/ANMC/LJF 6/23/2000
+1 ;I X["^" D:$D(SDFILE) DIK(.DFN,.SDE) G DIEQ ;IHS/ANMC/LJF 6/23/2000
+2 ;S:X="" X="NOW" S %DT="EXT" D ^%DT G:Y<0 DATE ;IHS/ANMC/LJF 6/23/2000
+3 ;IHS/ANMC/LJF 6/23/2000
SET X="NOW"
SET %DT="EXT"
DO ^%DT
IF Y<0
GOTO DATE
+4 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)
+5 ;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
+6 ;IHS/ANMC/LJF 6/23/2000
KILL DO,DD
SET X=Y
SET DA(2)=DFN
SET DA(1)=SDE
SET DIC("DR")="1///O"
SET DIC="^DPT("_DA(2)_",""DE"","_DA(1)_",1,"
SET DIC(0)="L"
DO FILE^DICN
KILL DIC,DD,D0
+7 IF Y<1
IF $DATA(SDFILE)
DO DIK(.DFN,.SDE)
+8 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
