SDAMEX ;ALB/MJK,RMO - Appointment Check In/Check Out ; 12/1/91
;;5.3;Scheduling;;Aug 13, 1993
;
EN ; -- main entry point
N SDATA,SDTOT,DFN,SDACT,SDATE,SDT,SDCL,SDDA,SDASH,SDAMDD,SDMAX
I '$$INIT G ENQ
S SDACT=$$ASK(DT) G ENQ:SDACT']""
F Q:'$$DATE(.SDATE) K SDCL D Q:SDTOT'<SDMAX
.F Q:'$$CLINIC(SDATE,.SDCL) K DFN D Q:SDTOT'<SDMAX
..F Q:'$$PAT(.SDATE,.SDCL,SDACT,.DFN,.SDT,.SDDA) D Q:SDTOT'<SDMAX
...S SDTOT=SDTOT+$$CK^SDAMEX1(DFN,SDCL,SDT,SDDA,SDACT)
W !!?5,"Total Appointments Processed: ",SDTOT
ENQ Q
;
INIT() ; -- set up vars
S SDTOT=0,SDMAX=9999,$P(SDASH,"_",IOM)="",SDAMDD=$P(^DD(2.98,3,0),U,3)
Q 1
;
ASK(SDDT) ; -- select appt CI or CO
N DIR,DIRUT,DTOUT,DUOUT,Y
S DIR(0)="SB^CI:Check In;CO:Check Out"
S DIR("A")="Select Appointment Check In or Check Out"
S:$G(SDDT) DIR("B")=$S($$REQ^SDM1A(SDDT)="CO":"Check Out",1:"Check In")
W ! D ^DIR S:$D(DIRUT) Y=""
Q $G(Y)
;
DATE(SDATE) ; -- get appt date
; input: none
; output: SDATE := appt date selected
; returned: date selected [1 := yes | 0 := no]
;
S DIR(0)="DO^:"_DT_":EPX",DIR("A")=$S($D(SDATE):"Next ",1:"")_"Appointment Date"
S:'$D(SDATE) DIR("B")="TODAY"
W ! D ^DIR K DIR S SDATE=Y
Q $S($D(DIRUT):0,Y:1,1:0)
;
CLINIC(SDATE,SDCL) ; -- get clinic
; input: SDATE := appt date selected
; output: SDCL := ifn of selected clinic
; returned: clinic selected [1 := yes | 0 := no]
;
N X,Y,SDDEF
CL W !,$S($D(SDCL):"Next",1:"Select")_" Clinic: "
S SDDEF=$S($P($O(^SC(+$G(^DISV(DUZ,"^SC(")),"S",SDATE)),".")=SDATE:+$G(^DISV(DUZ,"^SC(")),1:0)
I '$D(SDCL),$G(^SC(SDDEF,0))]"" W $P(^(0),U)_"// "
R X:DTIME
I X="",SDDEF,'$D(SDCL) S X="`"_SDDEF
I "^"[X S SDCL=0 G CLINICQ
S:X?1" "1N.N X="`"_$E(X,2,99)
S DIC(0)="NEMQ",DIC="^SC("
S DIC("S")="I $P(^(0),U,3)[""C"",$P($O(^(""S"",SDATE)),""."")=SDATE"
D ^DIC K DIC G CL:Y<1 S SDCL=+Y
CLINICQ Q SDCL>0
;
PAT(SDATE,SDCL,SDACT,DFN,SDT,SDDA) ; -- ask for pats & get appt
; input: SDATE := appt date
; SDCL := ifn of clinic
; SDACT := action CI or CO
; output: DFN
; SDT := appt date/time
; SDDA := ifn of ^sc multiple
; returned: appt selected [1 := yes | 0 := no]
;
N X,SDCNT,SDLCNT,SDAPPT
PT W !,SDASH S (SDDA,SDT)=0
W !!,$S($D(DFN):"Next",1:"Select")_" Patient: " R X:DTIME G PATQ:"^"[X
IF X["?" D PTHLP(SDCL,SDATE) G PT
D RT S DIC="^DPT(",DIC(0)="QEM" D ^DIC K DIC G PT:Y<1
S DFN=+Y
S (SDLCNT,SDCNT)=$$LIST(.DFN,.SDCL,.SDATE,.SDAPPT)
I 'SDCNT W !?7,"o No appointments for this patient.",*7 G PT
I SDCNT>1 D G PT:'SDCNT
.S DIR(0)="N^1:"_SDCNT,SDCNT=0,DIR("A")="Select Appointment" D ^DIR K DIR S SDCNT=+Y
I $D(SDAPPT(SDCNT)) D G PT:'SDDA
.S SDT=+SDAPPT(SDCNT),SDDA=+$P(SDAPPT(SDCNT),U,2),SDATA=$G(^DPT(DFN,"S",SDT,0))
.I SDLCNT>1 W ! D PRT
.I 'SDDA K SDAPPT W !?7,"o This appointment cannot be checked ",$S(SDACT="CO":"out",1:"in"),".",*7
PATQ Q SDDA>0
;
LIST(DFN,SDCL,SDATE,SDAPPT) ;
; input: DFN
; SDCL := ifn of clinic
; SDATE := appt date ; SDCL := ifn of clinic
; output SDAPPT := array of choices (appt d/t ^ multiple ifn)
; returned: count of appts for date
;
N SDCNT
W !!?5,"Clinic",?30,"Appointment Date/Time",?55,"Status"
W !?5,"------",?30,"---------------------",?55,"------"
S SDT=SDATE,DATE=0,SDCNT=0
F S SDT=$O(^DPT(DFN,"S",SDT)) Q:'SDT!(SDT>(SDATE_".2359")) I $D(^(SDT,0)) S SDATA=^(0) I SDCL=+SDATA D
.S SDCNT=SDCNT+1,SDAPPT(SDCNT)=SDT_U_+$$FIND^SDAM2(DFN,SDT,SDCL)
.D PRT
LISTQ Q SDCNT
;
PRT W !?1,SDCNT,?5,$E($P($G(^SC(SDCL,0)),U),1,25),?30,$$FTIME^VALM1(SDT),?55,$P($$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA),";",3)
Q
;
RT ; -- is this a rt rec
N C
I X?.N1"/"1N.ANP S C=$$CHAR($E(X,1,$L(X)-1)) I C]"",C=$E(X,$L(X)),$D(^RT(+$P(X,"/",2),0)),$P(^(0),U,9) S X="`"_+$P(^(0),U,9)
Q
CHAR(X) ; -- char checksum for code 39
N C,Z,I,Y
S C="",Z="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%"
F I=1:1:$L(X) S Y=$F(Z,$E(X,I))-2 Q:Y<0 S C=C+Y
Q $S(Y'<0:$E(Z,(C#43)+1),1:"")
;
PTHLP(SDCL,START) ;
N END,SDT,SDDA,SDATA,SDCNT,X,DFN,SDESC,VA
S END=START+.2359,SDCNT=0,SDESC=0
W !,"The following appointments are listed for the clinic on the selected date:"
F SDT=START:0 S SDT=$O(^SC(SDCL,"S",SDT)) Q:'SDT!(SDT>END) D Q:SDESC
.S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:'SDDA S X=^SC(SDCL,"S",SDT,1,SDDA,0) D Q:SDESC
..S DFN=+X,SDATA=$G(^DPT(DFN,"S",SDT,0))
..I SDCL=+SDATA,$$VALID^SDAM2(DFN,SDCL,SDT,SDDA) S SDCNT=SDCNT+1 D PID^VADPT6 D
...W !,$E($P($G(^DPT(DFN,0)),U),1,20),?21,VA("BID"),?30,$$FTIME^VALM1(SDT),?55,$P($$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA),";",3)
...I '(SDCNT#20) S DIR(0)="E" D ^DIR K DIR S SDESC='Y
I SDCNT=0 W !!?5,"...There are no appointments for this clinic on this date.",*7
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMEX 4829 printed Oct 16, 2024@18:48:18 Page 2
SDAMEX ;ALB/MJK,RMO - Appointment Check In/Check Out ; 12/1/91
+1 ;;5.3;Scheduling;;Aug 13, 1993
+2 ;
EN ; -- main entry point
+1 NEW SDATA,SDTOT,DFN,SDACT,SDATE,SDT,SDCL,SDDA,SDASH,SDAMDD,SDMAX
+2 IF '$$INIT
GOTO ENQ
+3 SET SDACT=$$ASK(DT)
if SDACT']""
GOTO ENQ
+4 FOR
if '$$DATE(.SDATE)
QUIT
KILL SDCL
Begin DoDot:1
+5 FOR
if '$$CLINIC(SDATE,.SDCL)
QUIT
KILL DFN
Begin DoDot:2
+6 FOR
if '$$PAT(.SDATE,.SDCL,SDACT,.DFN,.SDT,.SDDA)
QUIT
Begin DoDot:3
+7 SET SDTOT=SDTOT+$$CK^SDAMEX1(DFN,SDCL,SDT,SDDA,SDACT)
End DoDot:3
if SDTOT'<SDMAX
QUIT
End DoDot:2
if SDTOT'<SDMAX
QUIT
End DoDot:1
if SDTOT'<SDMAX
QUIT
+8 WRITE !!?5,"Total Appointments Processed: ",SDTOT
ENQ QUIT
+1 ;
INIT() ; -- set up vars
+1 SET SDTOT=0
SET SDMAX=9999
SET $PIECE(SDASH,"_",IOM)=""
SET SDAMDD=$PIECE(^DD(2.98,3,0),U,3)
+2 QUIT 1
+3 ;
ASK(SDDT) ; -- select appt CI or CO
+1 NEW DIR,DIRUT,DTOUT,DUOUT,Y
+2 SET DIR(0)="SB^CI:Check In;CO:Check Out"
+3 SET DIR("A")="Select Appointment Check In or Check Out"
+4 if $GET(SDDT)
SET DIR("B")=$SELECT($$REQ^SDM1A(SDDT)="CO":"Check Out",1:"Check In")
+5 WRITE !
DO ^DIR
if $DATA(DIRUT)
SET Y=""
+6 QUIT $GET(Y)
+7 ;
DATE(SDATE) ; -- get appt date
+1 ; input: none
+2 ; output: SDATE := appt date selected
+3 ; returned: date selected [1 := yes | 0 := no]
+4 ;
+5 SET DIR(0)="DO^:"_DT_":EPX"
SET DIR("A")=$SELECT($DATA(SDATE):"Next ",1:"")_"Appointment Date"
+6 if '$DATA(SDATE)
SET DIR("B")="TODAY"
+7 WRITE !
DO ^DIR
KILL DIR
SET SDATE=Y
+8 QUIT $SELECT($DATA(DIRUT):0,Y:1,1:0)
+9 ;
CLINIC(SDATE,SDCL) ; -- get clinic
+1 ; input: SDATE := appt date selected
+2 ; output: SDCL := ifn of selected clinic
+3 ; returned: clinic selected [1 := yes | 0 := no]
+4 ;
+5 NEW X,Y,SDDEF
CL WRITE !,$SELECT($DATA(SDCL):"Next",1:"Select")_" Clinic: "
+1 SET SDDEF=$SELECT($PIECE($ORDER(^SC(+$GET(^DISV(DUZ,"^SC(")),"S",SDATE)),".")=SDATE:+$GET(^DISV(DUZ,"^SC(")),1:0)
+2 IF '$DATA(SDCL)
IF $GET(^SC(SDDEF,0))]""
WRITE $PIECE(^(0),U)_"// "
+3 READ X:DTIME
+4 IF X=""
IF SDDEF
IF '$DATA(SDCL)
SET X="`"_SDDEF
+5 IF "^"[X
SET SDCL=0
GOTO CLINICQ
+6 if X?1" "1N.N
SET X="`"_$EXTRACT(X,2,99)
+7 SET DIC(0)="NEMQ"
SET DIC="^SC("
+8 SET DIC("S")="I $P(^(0),U,3)[""C"",$P($O(^(""S"",SDATE)),""."")=SDATE"
+9 DO ^DIC
KILL DIC
if Y<1
GOTO CL
SET SDCL=+Y
CLINICQ QUIT SDCL>0
+1 ;
PAT(SDATE,SDCL,SDACT,DFN,SDT,SDDA) ; -- ask for pats & get appt
+1 ; input: SDATE := appt date
+2 ; SDCL := ifn of clinic
+3 ; SDACT := action CI or CO
+4 ; output: DFN
+5 ; SDT := appt date/time
+6 ; SDDA := ifn of ^sc multiple
+7 ; returned: appt selected [1 := yes | 0 := no]
+8 ;
+9 NEW X,SDCNT,SDLCNT,SDAPPT
PT WRITE !,SDASH
SET (SDDA,SDT)=0
+1 WRITE !!,$SELECT($DATA(DFN):"Next",1:"Select")_" Patient: "
READ X:DTIME
if "^"[X
GOTO PATQ
+2 IF X["?"
DO PTHLP(SDCL,SDATE)
GOTO PT
+3 DO RT
SET DIC="^DPT("
SET DIC(0)="QEM"
DO ^DIC
KILL DIC
if Y<1
GOTO PT
+4 SET DFN=+Y
+5 SET (SDLCNT,SDCNT)=$$LIST(.DFN,.SDCL,.SDATE,.SDAPPT)
+6 IF 'SDCNT
WRITE !?7,"o No appointments for this patient.",*7
GOTO PT
+7 IF SDCNT>1
Begin DoDot:1
+8 SET DIR(0)="N^1:"_SDCNT
SET SDCNT=0
SET DIR("A")="Select Appointment"
DO ^DIR
KILL DIR
SET SDCNT=+Y
End DoDot:1
if 'SDCNT
GOTO PT
+9 IF $DATA(SDAPPT(SDCNT))
Begin DoDot:1
+10 SET SDT=+SDAPPT(SDCNT)
SET SDDA=+$PIECE(SDAPPT(SDCNT),U,2)
SET SDATA=$GET(^DPT(DFN,"S",SDT,0))
+11 IF SDLCNT>1
WRITE !
DO PRT
+12 IF 'SDDA
KILL SDAPPT
WRITE !?7,"o This appointment cannot be checked ",$SELECT(SDACT="CO":"out",1:"in"),".",*7
End DoDot:1
if 'SDDA
GOTO PT
PATQ QUIT SDDA>0
+1 ;
LIST(DFN,SDCL,SDATE,SDAPPT) ;
+1 ; input: DFN
+2 ; SDCL := ifn of clinic
+3 ; SDATE := appt date ; SDCL := ifn of clinic
+4 ; output SDAPPT := array of choices (appt d/t ^ multiple ifn)
+5 ; returned: count of appts for date
+6 ;
+7 NEW SDCNT
+8 WRITE !!?5,"Clinic",?30,"Appointment Date/Time",?55,"Status"
+9 WRITE !?5,"------",?30,"---------------------",?55,"------"
+10 SET SDT=SDATE
SET DATE=0
SET SDCNT=0
+11 FOR
SET SDT=$ORDER(^DPT(DFN,"S",SDT))
if 'SDT!(SDT>(SDATE_".2359"))
QUIT
IF $DATA(^(SDT,0))
SET SDATA=^(0)
IF SDCL=+SDATA
Begin DoDot:1
+12 SET SDCNT=SDCNT+1
SET SDAPPT(SDCNT)=SDT_U_+$$FIND^SDAM2(DFN,SDT,SDCL)
+13 DO PRT
End DoDot:1
LISTQ QUIT SDCNT
+1 ;
PRT WRITE !?1,SDCNT,?5,$EXTRACT($PIECE($GET(^SC(SDCL,0)),U),1,25),?30,$$FTIME^VALM1(SDT),?55,$PIECE($$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA),";",3)
+1 QUIT
+2 ;
RT ; -- is this a rt rec
+1 NEW C
+2 IF X?.N1"/"1N.ANP
SET C=$$CHAR($EXTRACT(X,1,$LENGTH(X)-1))
IF C]""
IF C=$EXTRACT(X,$LENGTH(X))
IF $DATA(^RT(+$PIECE(X,"/",2),0))
IF $PIECE(^(0),U,9)
SET X="`"_+$PIECE(^(0),U,9)
+3 QUIT
CHAR(X) ; -- char checksum for code 39
+1 NEW C,Z,I,Y
+2 SET C=""
SET Z="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%"
+3 FOR I=1:1:$LENGTH(X)
SET Y=$FIND(Z,$EXTRACT(X,I))-2
if Y<0
QUIT
SET C=C+Y
+4 QUIT $SELECT(Y'<0:$EXTRACT(Z,(C#43)+1),1:"")
+5 ;
PTHLP(SDCL,START) ;
+1 NEW END,SDT,SDDA,SDATA,SDCNT,X,DFN,SDESC,VA
+2 SET END=START+.2359
SET SDCNT=0
SET SDESC=0
+3 WRITE !,"The following appointments are listed for the clinic on the selected date:"
+4 FOR SDT=START:0
SET SDT=$ORDER(^SC(SDCL,"S",SDT))
if 'SDT!(SDT>END)
QUIT
Begin DoDot:1
+5 SET SDDA=0
FOR
SET SDDA=$ORDER(^SC(SDCL,"S",SDT,1,SDDA))
if 'SDDA
QUIT
SET X=^SC(SDCL,"S",SDT,1,SDDA,0)
Begin DoDot:2
+6 SET DFN=+X
SET SDATA=$GET(^DPT(DFN,"S",SDT,0))
+7 IF SDCL=+SDATA
IF $$VALID^SDAM2(DFN,SDCL,SDT,SDDA)
SET SDCNT=SDCNT+1
DO PID^VADPT6
Begin DoDot:3
+8 WRITE !,$EXTRACT($PIECE($GET(^DPT(DFN,0)),U),1,20),?21,VA("BID"),?30,$$FTIME^VALM1(SDT),?55,$PIECE($$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA),";",3)
+9 IF '(SDCNT#20)
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET SDESC='Y
End DoDot:3
End DoDot:2
if SDESC
QUIT
End DoDot:1
if SDESC
QUIT
+10 IF SDCNT=0
WRITE !!?5,"...There are no appointments for this clinic on this date.",*7
+11 QUIT
