1 | SDAMEX ;ALB/MJK,RMO - Appointment Check In/Check Out ; 12/1/91
|
---|
2 | ;;5.3;Scheduling;;Aug 13, 1993
|
---|
3 | ;
|
---|
4 | EN ; -- main entry point
|
---|
5 | N SDATA,SDTOT,DFN,SDACT,SDATE,SDT,SDCL,SDDA,SDASH,SDAMDD,SDMAX
|
---|
6 | I '$$INIT G ENQ
|
---|
7 | S SDACT=$$ASK(DT) G ENQ:SDACT']""
|
---|
8 | F Q:'$$DATE(.SDATE) K SDCL D Q:SDTOT'<SDMAX
|
---|
9 | .F Q:'$$CLINIC(SDATE,.SDCL) K DFN D Q:SDTOT'<SDMAX
|
---|
10 | ..F Q:'$$PAT(.SDATE,.SDCL,SDACT,.DFN,.SDT,.SDDA) D Q:SDTOT'<SDMAX
|
---|
11 | ...S SDTOT=SDTOT+$$CK^SDAMEX1(DFN,SDCL,SDT,SDDA,SDACT)
|
---|
12 | W !!?5,"Total Appointments Processed: ",SDTOT
|
---|
13 | ENQ Q
|
---|
14 | ;
|
---|
15 | INIT() ; -- set up vars
|
---|
16 | S SDTOT=0,SDMAX=9999,$P(SDASH,"_",IOM)="",SDAMDD=$P(^DD(2.98,3,0),U,3)
|
---|
17 | Q 1
|
---|
18 | ;
|
---|
19 | ASK(SDDT) ; -- select appt CI or CO
|
---|
20 | N DIR,DIRUT,DTOUT,DUOUT,Y
|
---|
21 | S DIR(0)="SB^CI:Check In;CO:Check Out"
|
---|
22 | S DIR("A")="Select Appointment Check In or Check Out"
|
---|
23 | S:$G(SDDT) DIR("B")=$S($$REQ^SDM1A(SDDT)="CO":"Check Out",1:"Check In")
|
---|
24 | W ! D ^DIR S:$D(DIRUT) Y=""
|
---|
25 | Q $G(Y)
|
---|
26 | ;
|
---|
27 | DATE(SDATE) ; -- get appt date
|
---|
28 | ; input: none
|
---|
29 | ; output: SDATE := appt date selected
|
---|
30 | ; returned: date selected [1 := yes | 0 := no]
|
---|
31 | ;
|
---|
32 | S DIR(0)="DO^:"_DT_":EPX",DIR("A")=$S($D(SDATE):"Next ",1:"")_"Appointment Date"
|
---|
33 | S:'$D(SDATE) DIR("B")="TODAY"
|
---|
34 | W ! D ^DIR K DIR S SDATE=Y
|
---|
35 | Q $S($D(DIRUT):0,Y:1,1:0)
|
---|
36 | ;
|
---|
37 | CLINIC(SDATE,SDCL) ; -- get clinic
|
---|
38 | ; input: SDATE := appt date selected
|
---|
39 | ; output: SDCL := ifn of selected clinic
|
---|
40 | ; returned: clinic selected [1 := yes | 0 := no]
|
---|
41 | ;
|
---|
42 | N X,Y,SDDEF
|
---|
43 | CL W !,$S($D(SDCL):"Next",1:"Select")_" Clinic: "
|
---|
44 | S SDDEF=$S($P($O(^SC(+$G(^DISV(DUZ,"^SC(")),"S",SDATE)),".")=SDATE:+$G(^DISV(DUZ,"^SC(")),1:0)
|
---|
45 | I '$D(SDCL),$G(^SC(SDDEF,0))]"" W $P(^(0),U)_"// "
|
---|
46 | R X:DTIME
|
---|
47 | I X="",SDDEF,'$D(SDCL) S X="`"_SDDEF
|
---|
48 | I "^"[X S SDCL=0 G CLINICQ
|
---|
49 | S:X?1" "1N.N X="`"_$E(X,2,99)
|
---|
50 | S DIC(0)="NEMQ",DIC="^SC("
|
---|
51 | S DIC("S")="I $P(^(0),U,3)[""C"",$P($O(^(""S"",SDATE)),""."")=SDATE"
|
---|
52 | D ^DIC K DIC G CL:Y<1 S SDCL=+Y
|
---|
53 | CLINICQ Q SDCL>0
|
---|
54 | ;
|
---|
55 | PAT(SDATE,SDCL,SDACT,DFN,SDT,SDDA) ; -- ask for pats & get appt
|
---|
56 | ; input: SDATE := appt date
|
---|
57 | ; SDCL := ifn of clinic
|
---|
58 | ; SDACT := action CI or CO
|
---|
59 | ; output: DFN
|
---|
60 | ; SDT := appt date/time
|
---|
61 | ; SDDA := ifn of ^sc multiple
|
---|
62 | ; returned: appt selected [1 := yes | 0 := no]
|
---|
63 | ;
|
---|
64 | N X,SDCNT,SDLCNT,SDAPPT
|
---|
65 | PT W !,SDASH S (SDDA,SDT)=0
|
---|
66 | W !!,$S($D(DFN):"Next",1:"Select")_" Patient: " R X:DTIME G PATQ:"^"[X
|
---|
67 | IF X["?" D PTHLP(SDCL,SDATE) G PT
|
---|
68 | D RT S DIC="^DPT(",DIC(0)="QEM" D ^DIC K DIC G PT:Y<1
|
---|
69 | S DFN=+Y
|
---|
70 | S (SDLCNT,SDCNT)=$$LIST(.DFN,.SDCL,.SDATE,.SDAPPT)
|
---|
71 | I 'SDCNT W !?7,"o No appointments for this patient.",*7 G PT
|
---|
72 | I SDCNT>1 D G PT:'SDCNT
|
---|
73 | .S DIR(0)="N^1:"_SDCNT,SDCNT=0,DIR("A")="Select Appointment" D ^DIR K DIR S SDCNT=+Y
|
---|
74 | I $D(SDAPPT(SDCNT)) D G PT:'SDDA
|
---|
75 | .S SDT=+SDAPPT(SDCNT),SDDA=+$P(SDAPPT(SDCNT),U,2),SDATA=$G(^DPT(DFN,"S",SDT,0))
|
---|
76 | .I SDLCNT>1 W ! D PRT
|
---|
77 | .I 'SDDA K SDAPPT W !?7,"o This appointment cannot be checked ",$S(SDACT="CO":"out",1:"in"),".",*7
|
---|
78 | PATQ Q SDDA>0
|
---|
79 | ;
|
---|
80 | LIST(DFN,SDCL,SDATE,SDAPPT) ;
|
---|
81 | ; input: DFN
|
---|
82 | ; SDCL := ifn of clinic
|
---|
83 | ; SDATE := appt date ; SDCL := ifn of clinic
|
---|
84 | ; output SDAPPT := array of choices (appt d/t ^ multiple ifn)
|
---|
85 | ; returned: count of appts for date
|
---|
86 | ;
|
---|
87 | N SDCNT
|
---|
88 | W !!?5,"Clinic",?30,"Appointment Date/Time",?55,"Status"
|
---|
89 | W !?5,"------",?30,"---------------------",?55,"------"
|
---|
90 | S SDT=SDATE,DATE=0,SDCNT=0
|
---|
91 | F S SDT=$O(^DPT(DFN,"S",SDT)) Q:'SDT!(SDT>(SDATE_".2359")) I $D(^(SDT,0)) S SDATA=^(0) I SDCL=+SDATA D
|
---|
92 | .S SDCNT=SDCNT+1,SDAPPT(SDCNT)=SDT_U_+$$FIND^SDAM2(DFN,SDT,SDCL)
|
---|
93 | .D PRT
|
---|
94 | LISTQ Q SDCNT
|
---|
95 | ;
|
---|
96 | 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)
|
---|
97 | Q
|
---|
98 | ;
|
---|
99 | RT ; -- is this a rt rec
|
---|
100 | N C
|
---|
101 | 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)
|
---|
102 | Q
|
---|
103 | CHAR(X) ; -- char checksum for code 39
|
---|
104 | N C,Z,I,Y
|
---|
105 | S C="",Z="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%"
|
---|
106 | F I=1:1:$L(X) S Y=$F(Z,$E(X,I))-2 Q:Y<0 S C=C+Y
|
---|
107 | Q $S(Y'<0:$E(Z,(C#43)+1),1:"")
|
---|
108 | ;
|
---|
109 | PTHLP(SDCL,START) ;
|
---|
110 | N END,SDT,SDDA,SDATA,SDCNT,X,DFN,SDESC,VA
|
---|
111 | S END=START+.2359,SDCNT=0,SDESC=0
|
---|
112 | W !,"The following appointments are listed for the clinic on the selected date:"
|
---|
113 | F SDT=START:0 S SDT=$O(^SC(SDCL,"S",SDT)) Q:'SDT!(SDT>END) D Q:SDESC
|
---|
114 | .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
|
---|
115 | ..S DFN=+X,SDATA=$G(^DPT(DFN,"S",SDT,0))
|
---|
116 | ..I SDCL=+SDATA,$$VALID^SDAM2(DFN,SDCL,SDT,SDDA) S SDCNT=SDCNT+1 D PID^VADPT6 D
|
---|
117 | ...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)
|
---|
118 | ...I '(SDCNT#20) S DIR(0)="E" D ^DIR K DIR S SDESC='Y
|
---|
119 | I SDCNT=0 W !!?5,"...There are no appointments for this clinic on this date.",*7
|
---|
120 | Q
|
---|