SDAPIAE0 ;ALB/MJK - Outpatient API/Standalone Add/Edits ; 22 FEB 1994 11:30 am
;;5.3;Scheduling;**27,78,97,132**;08/13/93
;
EN(DFN,SDT,SDCL,SDUZ,SDMODE,SDVIEN) ; -- check api for appts
N SDOE
S SDOE=0
;
; -- verify that check-out can occur
D CHECK(DFN,SDT,SDCL) I $$ERRCHK^SDAPIER() G ENQ
;
; -- file check-out data and get back ien
S SDOE=$$FILE(SDVIEN,SDUZ,SDMODE)
;
ENQ Q SDOE
;
CHECK(DFN,SDT,SDCL) ; -- check if event can occur/allowed
;
; -- error if appt date if after today
I SDT>(DT+.24) D ERRFILE^SDAPIER(104,SDT) G CHECKQ
CHECKQ Q
;
FILE(SDVIEN,SDUZ,SDMODE) ; -- file data & return iens
N SDHDL,SDOE,SDOE0,SDOEP,SDX,DR,DIE,SDDR,DA,SDCOMPF,SDLOG,SDAEVT
;
S SDHDL=$$HANDLE^SDAMEVT(2)
;
; -- get encounter ien ; error if none returned
S SDOE=+$O(^SCE("AVSIT",SDVIEN,0))
;
; -- setup event driver data for existing encounter
IF SDOE D BEFORE^SDAMEVT2(SDOE,SDHDL)
;
; -- get encounter / set appt type if not set
IF 'SDOE D G:'SDOE FILEQ
. S SDOE=$$GETAE^SDVSIT2(SDVIEN,$G(@SDROOT@("APPT TYPE")))
. IF 'SDOE D ERRFILE^SDAPIER(110) Q
. S SDOE0=$G(^SCE(SDOE,0)),SDAEVT=6 ; -- add a/e event
. Q:$P(SDOE0,U,10) ; -- quit if appt type set
. S SDLOG("CG")=1 ; -- set computer generated?
. S SDX=$$TYPE(SDOE,$P(SDOE0,U,6)) ; -- determine appt type
. S SDLOG("APPT TYPE")=+SDX ; -- set appt type
. S:+SDX=10 SDLOG("REASON")=$P(SDX,U,2) ; -- set reason
;
; -- log user, date/time and standalone specific data
D LOGDATA^SDAPIAP(SDOE,.SDLOG)
;
; -- process data
D FILE^SDAPICO(SDOE,SDUZ)
;
; -- update co if deletion occurred
IF SDOE,'$$CHK^SDCOM(SDOE) D COMDT^SDCODEL(SDOE,0)
;
; -- update check-out completion
D EN^SDCOM(SDOE,SDMODE,SDHDL,.SDCOMPF)
;
; -- set visit change flag for event driver
D CHANGE^SDAMEVT4(.SDHDL,$P($G(^SCE(SDOE,0)),U,8),$G(@SDROOT@("VISIT CHANGE FLAGS")))
;
; -- get after values and invoke event driver
D EVT^SDAMEVT2(SDOE,$G(SDAEVT,7),SDHDL)
;
; -- cleanup event driver vars
D CLEAN^SDAMEVT(SDHDL)
FILEQ Q SDOE
;
TYPE(SDOE,SDOEP) ; -- Get Appt Type
; Input: SDOE - Outpatient Encounter pointer
; SDOEP - Outpatient Parent Encounter pointer
; Output: Appointment Type ^ reason for computer generated
;
N SDD,SDD1,SDI,SDCP,SDOE0,SDATE,X1,X2,X,VAERR,VAEL,SDX,SDQ,SDATYPE
S SDCP=0
;
;--If SDOEP exists, use its appointment type
IF $G(SDOEP) S SDATYPE=$P($G(^SCE(SDOEP,0)),U,10) IF SDATYPE G TYPEQ
;
;--search last 3 days + today in Outpatient Encounter file
S SDOE0=$G(^SCE(SDOE,0)),SDATE=$P(+SDOE0,".")
S X1=SDATE,X2="-3" D C^%DTC S SDD1=X,SDD=SDD1-.1 K X,%H,X1,X2
F S SDD=$O(^SCE("ADFN",DFN,SDD)) Q:'SDD!($P(SDD,".")>SDATE)!(SDCP) D
. S SDI=0
. F S SDI=$O(^SCE("ADFN",SDD,SDI)) Q:'SDI!(SDCP) IF $P($G(^SCE(SDI,0)),U,10)=1 S SDCP=1
;
;;search last 3 days + today in Patient File
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
;
I SDCP S SDATYPE=10 G TYPEQ
;
;if no comp and pen appts, try to determine based on eligibility
S SDATYPE=0 D ELIG^VADPT
I VAERR!'$G(VAEL(1)) S SDATYPE=10 G TYPEQ
S VAEL(1)=$P(^DIC(8,+VAEL(1),0),U,9)
S SDFLAG=$S(+VAEL(1)=9:8,+VAEL(1)=13:7,+VAEL(1)=14:4,1:0)
; *** rebuild Elig array from VAEL(1,#) using pointers to MAS ELIGIBILITY CODE File,
; #8.1, Check for SHARING AGREEMENT (9), COLLATERAL OF VET. (13) or EMPLOYEE (14)
;
I $D(VAEL(1))=11 D G:$G(SDQ) TYPEQ
. N ELG
. S SDX=0 F S SDX=$O(VAEL(1,SDX)) Q:'SDX D
.. S ELG(+$P($G(^DIC(8,+VAEL(1,SDX),0)),U,9))=""
. I $D(ELG(9))!($D(ELG(13)))!($D(ELG(14)))!SDFLAG S SDATYPE=10,SDQ=1
;
S SDATYPE=$S($D(VAEL(1))=1&(SDFLAG):SDFLAG,1:9)
;
; -- Appointment Type ^ reason for computer generated
TYPEQ Q SDATYPE_U_$S(SDCP:2,SDATYPE=10:1,1:"")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAPIAE0 3927 printed Apr 09, 2024@21:48:51 Page 2
SDAPIAE0 ;ALB/MJK - Outpatient API/Standalone Add/Edits ; 22 FEB 1994 11:30 am
+1 ;;5.3;Scheduling;**27,78,97,132**;08/13/93
+2 ;
EN(DFN,SDT,SDCL,SDUZ,SDMODE,SDVIEN) ; -- check api for appts
+1 NEW SDOE
+2 SET SDOE=0
+3 ;
+4 ; -- verify that check-out can occur
+5 DO CHECK(DFN,SDT,SDCL)
IF $$ERRCHK^SDAPIER()
GOTO ENQ
+6 ;
+7 ; -- file check-out data and get back ien
+8 SET SDOE=$$FILE(SDVIEN,SDUZ,SDMODE)
+9 ;
ENQ QUIT SDOE
+1 ;
CHECK(DFN,SDT,SDCL) ; -- check if event can occur/allowed
+1 ;
+2 ; -- error if appt date if after today
+3 IF SDT>(DT+.24)
DO ERRFILE^SDAPIER(104,SDT)
GOTO CHECKQ
CHECKQ QUIT
+1 ;
FILE(SDVIEN,SDUZ,SDMODE) ; -- file data & return iens
+1 NEW SDHDL,SDOE,SDOE0,SDOEP,SDX,DR,DIE,SDDR,DA,SDCOMPF,SDLOG,SDAEVT
+2 ;
+3 SET SDHDL=$$HANDLE^SDAMEVT(2)
+4 ;
+5 ; -- get encounter ien ; error if none returned
+6 SET SDOE=+$ORDER(^SCE("AVSIT",SDVIEN,0))
+7 ;
+8 ; -- setup event driver data for existing encounter
+9 IF SDOE
DO BEFORE^SDAMEVT2(SDOE,SDHDL)
+10 ;
+11 ; -- get encounter / set appt type if not set
+12 IF 'SDOE
Begin DoDot:1
+13 SET SDOE=$$GETAE^SDVSIT2(SDVIEN,$GET(@SDROOT@("APPT TYPE")))
+14 IF 'SDOE
DO ERRFILE^SDAPIER(110)
QUIT
+15 ; -- add a/e event
SET SDOE0=$GET(^SCE(SDOE,0))
SET SDAEVT=6
+16 ; -- quit if appt type set
if $PIECE(SDOE0,U,10)
QUIT
+17 ; -- set computer generated?
SET SDLOG("CG")=1
+18 ; -- determine appt type
SET SDX=$$TYPE(SDOE,$PIECE(SDOE0,U,6))
+19 ; -- set appt type
SET SDLOG("APPT TYPE")=+SDX
+20 ; -- set reason
if +SDX=10
SET SDLOG("REASON")=$PIECE(SDX,U,2)
End DoDot:1
if 'SDOE
GOTO FILEQ
+21 ;
+22 ; -- log user, date/time and standalone specific data
+23 DO LOGDATA^SDAPIAP(SDOE,.SDLOG)
+24 ;
+25 ; -- process data
+26 DO FILE^SDAPICO(SDOE,SDUZ)
+27 ;
+28 ; -- update co if deletion occurred
+29 IF SDOE
IF '$$CHK^SDCOM(SDOE)
DO COMDT^SDCODEL(SDOE,0)
+30 ;
+31 ; -- update check-out completion
+32 DO EN^SDCOM(SDOE,SDMODE,SDHDL,.SDCOMPF)
+33 ;
+34 ; -- set visit change flag for event driver
+35 DO CHANGE^SDAMEVT4(.SDHDL,$PIECE($GET(^SCE(SDOE,0)),U,8),$GET(@SDROOT@("VISIT CHANGE FLAGS")))
+36 ;
+37 ; -- get after values and invoke event driver
+38 DO EVT^SDAMEVT2(SDOE,$GET(SDAEVT,7),SDHDL)
+39 ;
+40 ; -- cleanup event driver vars
+41 DO CLEAN^SDAMEVT(SDHDL)
FILEQ QUIT SDOE
+1 ;
TYPE(SDOE,SDOEP) ; -- Get Appt Type
+1 ; Input: SDOE - Outpatient Encounter pointer
+2 ; SDOEP - Outpatient Parent Encounter pointer
+3 ; Output: Appointment Type ^ reason for computer generated
+4 ;
+5 NEW SDD,SDD1,SDI,SDCP,SDOE0,SDATE,X1,X2,X,VAERR,VAEL,SDX,SDQ,SDATYPE
+6 SET SDCP=0
+7 ;
+8 ;--If SDOEP exists, use its appointment type
+9 IF $GET(SDOEP)
SET SDATYPE=$PIECE($GET(^SCE(SDOEP,0)),U,10)
IF SDATYPE
GOTO TYPEQ
+10 ;
+11 ;--search last 3 days + today in Outpatient Encounter file
+12 SET SDOE0=$GET(^SCE(SDOE,0))
SET SDATE=$PIECE(+SDOE0,".")
+13 SET X1=SDATE
SET X2="-3"
DO C^%DTC
SET SDD1=X
SET SDD=SDD1-.1
KILL X,%H,X1,X2
+14 FOR
SET SDD=$ORDER(^SCE("ADFN",DFN,SDD))
if 'SDD!($PIECE(SDD,".")>SDATE)!(SDCP)
QUIT
Begin DoDot:1
+15 SET SDI=0
+16 FOR
SET SDI=$ORDER(^SCE("ADFN",SDD,SDI))
if 'SDI!(SDCP)
QUIT
IF $PIECE($GET(^SCE(SDI,0)),U,10)=1
SET SDCP=1
End DoDot:1
+17 ;
+18 ;;search last 3 days + today in Patient File
+19 IF 'SDCP
SET SDD=SDD1-.1
FOR
SET SDD=$ORDER(^DPT(DFN,"S",SDD))
if SDD'>0!(SDCP)!($PIECE(SDD,".")>SDATE)
QUIT
IF $PIECE($GET(^(SDD,0)),U,16)=1
SET SDCP=1
+20 ;
+21 IF SDCP
SET SDATYPE=10
GOTO TYPEQ
+22 ;
+23 ;if no comp and pen appts, try to determine based on eligibility
+24 SET SDATYPE=0
DO ELIG^VADPT
+25 IF VAERR!'$GET(VAEL(1))
SET SDATYPE=10
GOTO TYPEQ
+26 SET VAEL(1)=$PIECE(^DIC(8,+VAEL(1),0),U,9)
+27 SET SDFLAG=$SELECT(+VAEL(1)=9:8,+VAEL(1)=13:7,+VAEL(1)=14:4,1:0)
+28 ; *** rebuild Elig array from VAEL(1,#) using pointers to MAS ELIGIBILITY CODE File,
+29 ; #8.1, Check for SHARING AGREEMENT (9), COLLATERAL OF VET. (13) or EMPLOYEE (14)
+30 ;
+31 IF $DATA(VAEL(1))=11
Begin DoDot:1
+32 NEW ELG
+33 SET SDX=0
FOR
SET SDX=$ORDER(VAEL(1,SDX))
if 'SDX
QUIT
Begin DoDot:2
+34 SET ELG(+$PIECE($GET(^DIC(8,+VAEL(1,SDX),0)),U,9))=""
End DoDot:2
+35 IF $DATA(ELG(9))!($DATA(ELG(13)))!($DATA(ELG(14)))!SDFLAG
SET SDATYPE=10
SET SDQ=1
End DoDot:1
if $GET(SDQ)
GOTO TYPEQ
+36 ;
+37 SET SDATYPE=$SELECT($DATA(VAEL(1))=1&(SDFLAG):SDFLAG,1:9)
+38 ;
+39 ; -- Appointment Type ^ reason for computer generated
TYPEQ QUIT SDATYPE_U_$SELECT(SDCP:2,SDATYPE=10:1,1:"")
+1 ;
