SDAMWI ;ALB/MJK - Unscheduled Appointments ; 5/3/05 5:50pm
;;5.3;Scheduling;**63,94,241,250,296,380,327,1015**;Aug 13, 1993;Build 21
;IHS/ANMC/LJF 7/6/2000 added screen for principal clinics under WI
; 11/29/2000 added screen for clinics with prohibited access
; 12/07/2000 added last reg update to walkin
; 9/10/2001 added IHS1 line label to ask clinic again
;
EN(DFN,SC) ; -- main entry point
; input: DFN ; SC := clinic#
; returned: success or fail := 1/0
;
N SDY,SDAPTYP,SDRE,SDRE1,SDIN,SDSL,SDD,SDALLE,SDATD,SDDECOD,SDEC,SDEMP,SDOEL,SDPL,SDRT,SDSC,SDTTM,COLLAT,SDX,SDSTART,ORDER,SDREP,SDDA,SDCL
D 2^VADPT I +VADM(6) W !!?5,*7,"o Patient has died!" D PAUSE^VALM1 S SDY=0 G ENQ
S SDCL=SC,SDSL=$S($D(^SC(SC,"SL")):+^("SL"),1:""),SDD=0
K SDRE,SDIN,SDRE1
I $D(^SC(SC,"I")) S Y=^("I"),SDIN=+Y,SDRE=+$P(Y,U,2),SDRE1=$$FDATE^VALM1(SDRE)
I $D(SDIN),SDIN,SDIN'>DT,SDRE,SDRE>DT W !!?5,*7,"o Clinic is inactive from ",$$FTIME^VALM1(SDIN)," to "_SDRE1 D PAUSE^VALM1 S SDY=0 G ENQ
I $D(SDIN),SDIN,SDIN'>DT,'SDRE W !!?5,*7,"o Clinic is inactive as of ",$$FTIME^VALM1(SDIN) D PAUSE^VALM1 S SDY=0 G ENQ
N SDRES S SDRES=$$CLNCK^SDUTL2(SC,1)
I 'SDRES W !,?5,*7,"o Clinic MUST be corrected before continuing." D PAUSE^VALM1 S SDY=0 G ENQ
I '$$TIME(.DFN,.SC,.SDT) D WL^SDM1(SC) S SDY=0 G ENQ ;SD/327
S Y=SDT D ^SDM4 I X="^" S SDY=0 G ENQ
; ** SD*5.3*250 MT Blocking check removed
;S X="EASMTCHK" X ^%ZOSF("TEST") I $T N EASACT S EASACT="W" I $$MT^EASMTCHK(DFN,+$G(SDAPTYP),EASACT) D PAUSE^VALM1 S SDY=0 G ENQ
;-- get sub-category for appointment type
S SDXSCAT=$$SUB^DGSAUTL(SDAPTYP,2,"")
S SDY=$$MAKE^SDAMWI1(DFN,SDCL,SDT)
K SDXSCAT
ENQ D KVAR^VADPT
Q SDY
;
TIME(DFN,SC,SDT) ; -- get appt date/time
; input: DFN ; SC := clinic#
; output: SDT := date/time of wi appt
; returned: success or fail := 1/0
;
N SDY,%DT
ASK R !!,"APPOINTMENT TIME: NOW// ",X:DTIME S X=$$UPPER^VALM1(X)
I X["^"!('$T) S SDY=0 G TIMEQ
I X?.E1"?" D G ASK
.W !," Enter a time or date@time for the appointment or return for 'NOW'."
.W !,"The date must be today or earlier."
S:X=""!(X="N")!(X="NO") X="NOW"
I X'="NOW",X'["@" S X="T@"_X
S %DT="TEP",%DT(0)=-(DT+1) D ^%DT G ASK:Y<0 S SDT=Y
G:'$$CANCHK(.SC,.SDT) ASK
I $D(^DPT(DFN,"S",SDT,0)) W !?5,*7,"o Patient already has an appt on ",$$FTIME^VALM1(SDT) G ASK
S SDY=1
TIMEQ Q SDY
;
CANCHK(SC,SDT) ; -- is clinic cancelled for date
; input: SC := clinic# ; SDT := date/time of wi appt
; returned: success or fail := 1/0
;
N SDY
S SDY=1
I $D(^SC(SC,"ST",$P(SDT,"."))),'$D(^SC(SC,"ST",$P(SDT,"."),"CAN")) G CANCHKQ
I $D(^SC(SC,"ST",$P(SDT,"."),"CAN")),$G(^SC(SC,"ST",$P(SDT,"."),1))["CANCEL" W !?5,*7,"o This date's clinic has been cancelled!" S SDY=0 G CANCHKQ
I $D(^SC(SC,"ST",$P(SDT,"."),"CAN")),$G(^SC(SC,"ST",$P(SDT,"."),1))'["CANCEL" W !?5,*7,"o Warning: Part of this day's clinic has been cancelled!" G CANCHKQ
S SDY=$$AVAIL(.SC,.SDT)
CANCHKQ Q SDY
;
AVAIL(SC,SDT) ; -- does clinic meet
; input: SC := clinic# ; SDT := date/time of wi appt
; returned: success or fail := 1/0
;
N SDY
S X=$P(SDT,".") D DOW^SDM0
I $D(^SC(SC,"T"_Y)) S Z=$O(^SC(SC,"T"_Y,DT)) I Z'="",$D(^SC(SC,"T"_Y,Z,1)),^(1)]"" S SDY=1 G AVAILQ
W !?5,*7,"o Clinic does not meet on this date!" S SDY=0
AVAILQ Q SDY
;
CL(DFN) ; -- make wi appt
; input: DFN
; returned: success or fail := 1/0
;
W !?5,"Last Registration Update: ",$$LASTREG^BDGF2(DFN) ;IHS/ANMC/LJF 12/07/2000
IHS1 ;IHS/ANMC/LJF 9/10/2001 added line label
S DIC="^SC(",DIC(0)="AEMQ",DIC("A")="Select Clinic: ",DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))"
S DIC("S")=DIC("S")_",'$D(^SC(""AIHSPC"",+Y))" ;IHS/ANMC/LJF 7/6/2000
D ^DIC K DIC
I Y<0 S SDY=0 G CLQ
;
;IHS/ANMC/LJF 11/29/2000;9/10/2001
I $D(^SC(+Y,"SDPROT")),$P(^("SDPROT"),U)="Y",'$D(^SC(+Y,"SDPRIV",DUZ)),'$D(^SC($$PC^BSDU(+Y),"SDPRIV",DUZ)) W !,"Access to ",$$GET1^DIQ(44,+Y,.01)," is prohibited!",!,"Only users with a special code may access this clinic." D PAUSE^BDGF G IHS1
;
S SC=+Y S SDY=$$EN(.DFN,.SC)
CLQ Q SDY
;
PT(SC) ;
; input: SC := clinic#
; returned: success or fail := 1/0
;
S DIC="^DPT(",DIC(0)="AEMQ",DIC("A")="Select Patient: "
D ^DIC K DIC
I Y<0 S SDY=0 G PTQ
S DFN=+Y S SDY=$$EN(.DFN,.SC)
PTQ Q SDY
;
SDAMWI ;ALB/MJK - Unscheduled Appointments ; 5/3/05 5:50pm
+1 ;;5.3;Scheduling;**63,94,241,250,296,380,327,1015**;Aug 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 7/6/2000 added screen for principal clinics under WI
+3 ; 11/29/2000 added screen for clinics with prohibited access
+4 ; 12/07/2000 added last reg update to walkin
+5 ; 9/10/2001 added IHS1 line label to ask clinic again
+6 ;
EN(DFN,SC) ; -- main entry point
+1 ; input: DFN ; SC := clinic#
+2 ; returned: success or fail := 1/0
+3 ;
+4 NEW SDY,SDAPTYP,SDRE,SDRE1,SDIN,SDSL,SDD,SDALLE,SDATD,SDDECOD,SDEC,SDEMP,SDOEL,SDPL,SDRT,SDSC,SDTTM,COLLAT,SDX,SDSTART,ORDER,SDREP,SDDA,SDCL
+5 DO 2^VADPT
IF +VADM(6)
WRITE !!?5,*7,"o Patient has died!"
DO PAUSE^VALM1
SET SDY=0
GOTO ENQ
+6 SET SDCL=SC
SET SDSL=$SELECT($DATA(^SC(SC,"SL")):+^("SL"),1:"")
SET SDD=0
+7 KILL SDRE,SDIN,SDRE1
+8 IF $DATA(^SC(SC,"I"))
SET Y=^("I")
SET SDIN=+Y
SET SDRE=+$PIECE(Y,U,2)
SET SDRE1=$$FDATE^VALM1(SDRE)
+9 IF $DATA(SDIN)
IF SDIN
IF SDIN'>DT
IF SDRE
IF SDRE>DT
WRITE !!?5,*7,"o Clinic is inactive from ",$$FTIME^VALM1(SDIN)," to "_SDRE1
DO PAUSE^VALM1
SET SDY=0
GOTO ENQ
+10 IF $DATA(SDIN)
IF SDIN
IF SDIN'>DT
IF 'SDRE
WRITE !!?5,*7,"o Clinic is inactive as of ",$$FTIME^VALM1(SDIN)
DO PAUSE^VALM1
SET SDY=0
GOTO ENQ
+11 NEW SDRES
SET SDRES=$$CLNCK^SDUTL2(SC,1)
+12 IF 'SDRES
WRITE !,?5,*7,"o Clinic MUST be corrected before continuing."
DO PAUSE^VALM1
SET SDY=0
GOTO ENQ
+13 ;SD/327
IF '$$TIME(.DFN,.SC,.SDT)
DO WL^SDM1(SC)
SET SDY=0
GOTO ENQ
+14 SET Y=SDT
DO ^SDM4
IF X="^"
SET SDY=0
GOTO ENQ
+15 ; ** SD*5.3*250 MT Blocking check removed
+16 ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T N EASACT S EASACT="W" I $$MT^EASMTCHK(DFN,+$G(SDAPTYP),EASACT) D PAUSE^VALM1 S SDY=0 G ENQ
+17 ;-- get sub-category for appointment type
+18 SET SDXSCAT=$$SUB^DGSAUTL(SDAPTYP,2,"")
+19 SET SDY=$$MAKE^SDAMWI1(DFN,SDCL,SDT)
+20 KILL SDXSCAT
ENQ DO KVAR^VADPT
+1 QUIT SDY
+2 ;
TIME(DFN,SC,SDT) ; -- get appt date/time
+1 ; input: DFN ; SC := clinic#
+2 ; output: SDT := date/time of wi appt
+3 ; returned: success or fail := 1/0
+4 ;
+5 NEW SDY,%DT
ASK READ !!,"APPOINTMENT TIME: NOW// ",X:DTIME
SET X=$$UPPER^VALM1(X)
+1 IF X["^"!('$TEST)
SET SDY=0
GOTO TIMEQ
+2 IF X?.E1"?"
Begin DoDot:1
+3 WRITE !," Enter a time or date@time for the appointment or return for 'NOW'."
+4 WRITE !,"The date must be today or earlier."
End DoDot:1
GOTO ASK
+5 IF X=""!(X="N")!(X="NO")
SET X="NOW"
+6 IF X'="NOW"
IF X'["@"
SET X="T@"_X
+7 SET %DT="TEP"
SET %DT(0)=-(DT+1)
DO ^%DT
IF Y<0
GOTO ASK
SET SDT=Y
+8 IF '$$CANCHK(.SC,.SDT)
GOTO ASK
+9 IF $DATA(^DPT(DFN,"S",SDT,0))
WRITE !?5,*7,"o Patient already has an appt on ",$$FTIME^VALM1(SDT)
GOTO ASK
+10 SET SDY=1
TIMEQ QUIT SDY
+1 ;
CANCHK(SC,SDT) ; -- is clinic cancelled for date
+1 ; input: SC := clinic# ; SDT := date/time of wi appt
+2 ; returned: success or fail := 1/0
+3 ;
+4 NEW SDY
+5 SET SDY=1
+6 IF $DATA(^SC(SC,"ST",$PIECE(SDT,".")))
IF '$DATA(^SC(SC,"ST",$PIECE(SDT,"."),"CAN"))
GOTO CANCHKQ
+7 IF $DATA(^SC(SC,"ST",$PIECE(SDT,"."),"CAN"))
IF $GET(^SC(SC,"ST",$PIECE(SDT,"."),1))["CANCEL"
WRITE !?5,*7,"o This date's clinic has been cancelled!"
SET SDY=0
GOTO CANCHKQ
+8 IF $DATA(^SC(SC,"ST",$PIECE(SDT,"."),"CAN"))
IF $GET(^SC(SC,"ST",$PIECE(SDT,"."),1))'["CANCEL"
WRITE !?5,*7,"o Warning: Part of this day's clinic has been cancelled!"
GOTO CANCHKQ
+9 SET SDY=$$AVAIL(.SC,.SDT)
CANCHKQ QUIT SDY
+1 ;
AVAIL(SC,SDT) ; -- does clinic meet
+1 ; input: SC := clinic# ; SDT := date/time of wi appt
+2 ; returned: success or fail := 1/0
+3 ;
+4 NEW SDY
+5 SET X=$PIECE(SDT,".")
DO DOW^SDM0
+6 IF $DATA(^SC(SC,"T"_Y))
SET Z=$ORDER(^SC(SC,"T"_Y,DT))
IF Z'=""
IF $DATA(^SC(SC,"T"_Y,Z,1))
IF ^(1)]""
SET SDY=1
GOTO AVAILQ
+7 WRITE !?5,*7,"o Clinic does not meet on this date!"
SET SDY=0
AVAILQ QUIT SDY
+1 ;
CL(DFN) ; -- make wi appt
+1 ; input: DFN
+2 ; returned: success or fail := 1/0
+3 ;
+4 ;IHS/ANMC/LJF 12/07/2000
WRITE !?5,"Last Registration Update: ",$$LASTREG^BDGF2(DFN)
IHS1 ;IHS/ANMC/LJF 9/10/2001 added line label
+1 SET DIC="^SC("
SET DIC(0)="AEMQ"
SET DIC("A")="Select Clinic: "
SET DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))"
+2 ;IHS/ANMC/LJF 7/6/2000
SET DIC("S")=DIC("S")_",'$D(^SC(""AIHSPC"",+Y))"
+3 DO ^DIC
KILL DIC
+4 IF Y<0
SET SDY=0
GOTO CLQ
+5 ;
+6 ;IHS/ANMC/LJF 11/29/2000;9/10/2001
+7 IF $DATA(^SC(+Y,"SDPROT"))
IF $PIECE(^("SDPROT"),U)="Y"
IF '$DATA(^SC(+Y,"SDPRIV",DUZ))
IF '$DATA(^SC($$PC^BSDU(+Y),"SDPRIV",DUZ))
WRITE !,"Access to ",$$GET1^DIQ(44,+Y,.01)," is prohibited!",!,"Only users with a special code may access this clinic."
DO PAUSE^BDGF
GOTO IHS1
+8 ;
+9 SET SC=+Y
SET SDY=$$EN(.DFN,.SC)
CLQ QUIT SDY
+1 ;
PT(SC) ;
+1 ; input: SC := clinic#
+2 ; returned: success or fail := 1/0
+3 ;
+4 SET DIC="^DPT("
SET DIC(0)="AEMQ"
SET DIC("A")="Select Patient: "
+5 DO ^DIC
KILL DIC
+6 IF Y<0
SET SDY=0
GOTO PTQ
+7 SET DFN=+Y
SET SDY=$$EN(.DFN,.SC)
PTQ QUIT SDY
+1 ;
