source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAPIAE0.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1SDAPIAE0 ;ALB/MJK - Outpatient API/Standalone Add/Edits ; 22 FEB 1994 11:30 am
2 ;;5.3;Scheduling;**27,78,97,132**;08/13/93
3 ;
4EN(DFN,SDT,SDCL,SDUZ,SDMODE,SDVIEN) ; -- check api for appts
5 N SDOE
6 S SDOE=0
7 ;
8 ; -- verify that check-out can occur
9 D CHECK(DFN,SDT,SDCL) I $$ERRCHK^SDAPIER() G ENQ
10 ;
11 ; -- file check-out data and get back ien
12 S SDOE=$$FILE(SDVIEN,SDUZ,SDMODE)
13 ;
14ENQ Q SDOE
15 ;
16CHECK(DFN,SDT,SDCL) ; -- check if event can occur/allowed
17 ;
18 ; -- error if appt date if after today
19 I SDT>(DT+.24) D ERRFILE^SDAPIER(104,SDT) G CHECKQ
20CHECKQ Q
21 ;
22FILE(SDVIEN,SDUZ,SDMODE) ; -- file data & return iens
23 N SDHDL,SDOE,SDOE0,SDOEP,SDX,DR,DIE,SDDR,DA,SDCOMPF,SDLOG,SDAEVT
24 ;
25 S SDHDL=$$HANDLE^SDAMEVT(2)
26 ;
27 ; -- get encounter ien ; error if none returned
28 S SDOE=+$O(^SCE("AVSIT",SDVIEN,0))
29 ;
30 ; -- setup event driver data for existing encounter
31 IF SDOE D BEFORE^SDAMEVT2(SDOE,SDHDL)
32 ;
33 ; -- get encounter / set appt type if not set
34 IF 'SDOE D G:'SDOE FILEQ
35 . S SDOE=$$GETAE^SDVSIT2(SDVIEN,$G(@SDROOT@("APPT TYPE")))
36 . IF 'SDOE D ERRFILE^SDAPIER(110) Q
37 . S SDOE0=$G(^SCE(SDOE,0)),SDAEVT=6 ; -- add a/e event
38 . Q:$P(SDOE0,U,10) ; -- quit if appt type set
39 . S SDLOG("CG")=1 ; -- set computer generated?
40 . S SDX=$$TYPE(SDOE,$P(SDOE0,U,6)) ; -- determine appt type
41 . S SDLOG("APPT TYPE")=+SDX ; -- set appt type
42 . S:+SDX=10 SDLOG("REASON")=$P(SDX,U,2) ; -- set reason
43 ;
44 ; -- log user, date/time and standalone specific data
45 D LOGDATA^SDAPIAP(SDOE,.SDLOG)
46 ;
47 ; -- process data
48 D FILE^SDAPICO(SDOE,SDUZ)
49 ;
50 ; -- update co if deletion occurred
51 IF SDOE,'$$CHK^SDCOM(SDOE) D COMDT^SDCODEL(SDOE,0)
52 ;
53 ; -- update check-out completion
54 D EN^SDCOM(SDOE,SDMODE,SDHDL,.SDCOMPF)
55 ;
56 ; -- set visit change flag for event driver
57 D CHANGE^SDAMEVT4(.SDHDL,$P($G(^SCE(SDOE,0)),U,8),$G(@SDROOT@("VISIT CHANGE FLAGS")))
58 ;
59 ; -- get after values and invoke event driver
60 D EVT^SDAMEVT2(SDOE,$G(SDAEVT,7),SDHDL)
61 ;
62 ; -- cleanup event driver vars
63 D CLEAN^SDAMEVT(SDHDL)
64FILEQ Q SDOE
65 ;
66TYPE(SDOE,SDOEP) ; -- Get Appt Type
67 ; Input: SDOE - Outpatient Encounter pointer
68 ; SDOEP - Outpatient Parent Encounter pointer
69 ; Output: Appointment Type ^ reason for computer generated
70 ;
71 N SDD,SDD1,SDI,SDCP,SDOE0,SDATE,X1,X2,X,VAERR,VAEL,SDX,SDQ,SDATYPE
72 S SDCP=0
73 ;
74 ;--If SDOEP exists, use its appointment type
75 IF $G(SDOEP) S SDATYPE=$P($G(^SCE(SDOEP,0)),U,10) IF SDATYPE G TYPEQ
76 ;
77 ;--search last 3 days + today in Outpatient Encounter file
78 S SDOE0=$G(^SCE(SDOE,0)),SDATE=$P(+SDOE0,".")
79 S X1=SDATE,X2="-3" D C^%DTC S SDD1=X,SDD=SDD1-.1 K X,%H,X1,X2
80 F S SDD=$O(^SCE("ADFN",DFN,SDD)) Q:'SDD!($P(SDD,".")>SDATE)!(SDCP) D
81 . S SDI=0
82 . F S SDI=$O(^SCE("ADFN",SDD,SDI)) Q:'SDI!(SDCP) IF $P($G(^SCE(SDI,0)),U,10)=1 S SDCP=1
83 ;
84 ;;search last 3 days + today in Patient File
85 I 'SDCP S SDD=SDD1-.1 F S SDD=$O(^DPT(DFN,"S",SDD)) Q:SDD'>0!(SDCP)!($P(SDD,".")>SDATE) IF $P($G(^(SDD,0)),U,16)=1 S SDCP=1
86 ;
87 I SDCP S SDATYPE=10 G TYPEQ
88 ;
89 ;if no comp and pen appts, try to determine based on eligibility
90 S SDATYPE=0 D ELIG^VADPT
91 I VAERR!'$G(VAEL(1)) S SDATYPE=10 G TYPEQ
92 S VAEL(1)=$P(^DIC(8,+VAEL(1),0),U,9)
93 S SDFLAG=$S(+VAEL(1)=9:8,+VAEL(1)=13:7,+VAEL(1)=14:4,1:0)
94 ; *** rebuild Elig array from VAEL(1,#) using pointers to MAS ELIGIBILITY CODE File,
95 ; #8.1, Check for SHARING AGREEMENT (9), COLLATERAL OF VET. (13) or EMPLOYEE (14)
96 ;
97 I $D(VAEL(1))=11 D G:$G(SDQ) TYPEQ
98 . N ELG
99 . S SDX=0 F S SDX=$O(VAEL(1,SDX)) Q:'SDX D
100 .. S ELG(+$P($G(^DIC(8,+VAEL(1,SDX),0)),U,9))=""
101 . I $D(ELG(9))!($D(ELG(13)))!($D(ELG(14)))!SDFLAG S SDATYPE=10,SDQ=1
102 ;
103 S SDATYPE=$S($D(VAEL(1))=1&(SDFLAG):SDFLAG,1:9)
104 ;
105 ; -- Appointment Type ^ reason for computer generated
106TYPEQ Q SDATYPE_U_$S(SDCP:2,SDATYPE=10:1,1:"")
107 ;
Note: See TracBrowser for help on using the repository browser.