source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAPIAP.m@ 1147

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1SDAPIAP ;ALB/MJK - Outpatient API/Appointments ; 22 FEB 1994 11:30 am
2 ;;5.3;Scheduling;**27,132**;08/13/93
3 ;
4EN(DFN,SDT,SDCL,SDUZ,SDMODE,SDVIEN) ; -- check api for appts
5 N SDDA,SDOE
6 S SDOE=0
7 ; -- verify that check-out can occur
8 D CHECK(DFN,SDT,SDCL,.SDDA) I $$ERRCHK^SDAPIER() G ENQ
9 ;
10 ; -- file check-out data ; get encount ien
11 S SDOE=$$FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,$G(SDVIEN))
12 ;
13ENQ Q SDOE
14 ;
15CHECK(DFN,SDT,SDCL,SDDA) ; -- check if event can occur/allowed
16 N SDATA,STATUS
17 ; -- error if appt node doesn't exist
18 S SDATA=$G(^DPT(DFN,"S",SDT,0))
19 I SDATA="" D ERRFILE^SDAPIER(100,SDT_U_DFN) G CHECKQ
20 ;
21 ; -- error if different clinic
22 I +SDATA'=SDCL D ERRFILE^SDAPIER(101,+SDATA_U_SDCL) G CHECKQ
23 ;
24 ; -- error if no slot for appt
25 S SDDA=$$FIND^SDAM2(DFN,SDT,SDCL) I 'SDDA D ERRFILE^SDAPIER(102,SDT_U_SDCL) G CHECKQ
26 ;
27 ; -- get appt status data
28 S STATUS=$$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA)
29 ;
30 ; -- error if current status won't allow checking-out
31 I '$D(^SD(409.63,"ACO",1,+STATUS)) D ERRFILE^SDAPIER(103,$P(STATUS,";",2)) G CHECKQ
32 ;
33 ; -- warning if already checked-out
34 I $P(STATUS,";",2)="CHECKED OUT" D ERRFILE^SDAPIER(1100)
35 ;
36 ; -- error if appt date if after today
37 I SDT>(DT+.2359) D ERRFILE^SDAPIER(104,SDT) G CHECKQ
38CHECKQ Q
39 ;
40FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,SDVIEN) ; -- file data
41 N SDATA,SDHDL,SDOE,SDCOMPF,SDLOG
42 S SDOE=""
43 ;
44 ; -- setup event driver data
45 D BEFORE^SDCO1(.SDATA,DFN,SDT,SDCL,SDDA,.SDHDL)
46 ;
47 ; -- set elig for appt
48 D ELIG^SDCO1(DFN,SDT,SDCL,SDDA) ; may need to expand
49 ;
50 ; -- get encounter ien ; error if none returned
51 S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL,$G(SDVIEN))
52 I 'SDOE D ERRFILE^SDAPIER(110) G FILEQ
53 ;
54 ; -- time stamp check-out and log data
55 D DT(DFN,SDT,SDCL,SDDA,$G(@SDROOT@("DATE/TIME")))
56 D LOGDATA(SDOE)
57 ;
58 ; -- process data
59 D FILE^SDAPICO(SDOE,SDUZ)
60 ;
61 ; -- update check-out completion
62 D EN^SDCOM(SDOE,SDMODE,SDHDL,.SDCOMPF)
63 ;
64 ; -- set visit change flag for event driver
65 D CHANGE^SDAMEVT4(.SDHDL,$P($G(^SCE(SDOE,0)),U,8),$G(@SDROOT@("VISIT CHANGE FLAGS")))
66 ;
67 ; -- get after values and invoke event driver
68 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)
69 D EVT^SDAMEVT(.SDATA,5,SDMODE,SDHDL)
70 ;
71 ; -- cleanup event driver vars
72 D CLEAN^SDAMEVT(SDHDL)
73 ;
74FILEQ Q SDOE
75 ;
76DT(DFN,SDT,SDCL,SDDA,SDCODT) ; -- time stamp check out date
77 ; -- NOTE: this code duplicates at DT^SDCO1 but silent
78 N %DT,DR,SDCIDT,X,DIE,DA
79 S:'$D(^SC(SDCL,"S",0)) ^(0)="^44.001DA^^"
80 S X=$G(^SC(SDCL,"S",SDT,1,SDDA,"C")),SDCIDT=+X
81 ;IF $P(X,U,3) G DTQ
82 S DR="" IF $G(SDCODT) S DR="303R////"_$S(SDCODT<SDCIDT:SDCIDT,1:SDCODT)
83 IF DR]"" D DIE^SDCO1(SDCL,SDT,SDDA,DR)
84DTQ Q
85 ;
86LOGDATA(SDOE,SDLOG) ; -- log user, date/time and other data
87 N DIE,DA,DR,Y,X
88 S SDLOG("USER")=$S(+$G(SDUZ):+SDUZ,1:$G(DUZ)) ; -- editing user
89 S SDLOG("DATE/TIME")=$$NOW^XLFDT() ; -- last edited
90 S DIE="^SCE(",DA=SDOE,DR="[SD ENCOUNTER LOG]" D ^DIE
91 Q
92 ;
Note: See TracBrowser for help on using the repository browser.