source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAMEX.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.6 KB
RevLine 
[613]1SDAMEX ;ALB/MJK,RMO - Appointment Check In/Check Out ; 12/1/91
2 ;;5.3;Scheduling;;Aug 13, 1993
3 ;
4EN ; -- 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
13ENQ Q
14 ;
15INIT() ; -- 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 ;
19ASK(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 ;
27DATE(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 ;
37CLINIC(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
43CL 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
53CLINICQ Q SDCL>0
54 ;
55PAT(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
65PT 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
78PATQ Q SDDA>0
79 ;
80LIST(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
94LISTQ Q SDCNT
95 ;
96PRT 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 ;
99RT ; -- 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
103CHAR(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 ;
109PTHLP(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
Note: See TracBrowser for help on using the repository browser.