Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDAPIAE0

SDAPIAE0.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EN(DFN,SDT,SDCL,SDUZ,SDMODE,SDVIEN) ; -- check api for appts
  1.  N SDOE
  1.  S SDOE=0
  1.  ;
  1.  ; -- verify that check-out can occur
  1.  D CHECK(DFN,SDT,SDCL) I $$ERRCHK^SDAPIER() G ENQ
  1.  ;
  1.  ; -- file check-out data and get back ien
  1.  S SDOE=$$FILE(SDVIEN,SDUZ,SDMODE)
  1.  ;
  1. ENQ Q SDOE
  1.  ;
  1. CHECK(DFN,SDT,SDCL) ; -- check if event can occur/allowed
  1.  ;
  1.  ; -- error if appt date if after today
  1.  I SDT>(DT+.24) D ERRFILE^SDAPIER(104,SDT) G CHECKQ
  1. CHECKQ Q
  1.  ;
  1. FILE(SDVIEN,SDUZ,SDMODE) ; -- file data & return iens
  1.  N SDHDL,SDOE,SDOE0,SDOEP,SDX,DR,DIE,SDDR,DA,SDCOMPF,SDLOG,SDAEVT
  1.  ;
  1.  S SDHDL=$$HANDLE^SDAMEVT(2)
  1.  ;
  1.  ; -- get encounter ien ; error if none returned
  1.  S SDOE=+$O(^SCE("AVSIT",SDVIEN,0))
  1.  ;
  1.  ; -- setup event driver data for existing encounter
  1.  IF SDOE D BEFORE^SDAMEVT2(SDOE,SDHDL)
  1.  ;
  1.  ; -- get encounter / set appt type if not set
  1.  IF 'SDOE D  G:'SDOE FILEQ
  1.  . S SDOE=$$GETAE^SDVSIT2(SDVIEN,$G(@SDROOT@("APPT TYPE")))
  1.  . IF 'SDOE D ERRFILE^SDAPIER(110) Q
  1.  . S SDOE0=$G(^SCE(SDOE,0)),SDAEVT=6       ; -- add a/e event
  1.  . Q:$P(SDOE0,U,10)                        ; -- quit if appt type set
  1.  . S SDLOG("CG")=1                         ; -- set computer generated?
  1.  . S SDX=$$TYPE(SDOE,$P(SDOE0,U,6))        ; -- determine appt type
  1.  . S SDLOG("APPT TYPE")=+SDX               ; -- set appt type
  1.  . S:+SDX=10 SDLOG("REASON")=$P(SDX,U,2)   ; -- set reason
  1.  ;
  1.  ; -- log user, date/time and standalone specific data
  1.  D LOGDATA^SDAPIAP(SDOE,.SDLOG)
  1.  ;
  1.  ; -- process data
  1.  D FILE^SDAPICO(SDOE,SDUZ)
  1.  ;
  1.  ; -- update co if deletion occurred
  1.  IF SDOE,'$$CHK^SDCOM(SDOE) D COMDT^SDCODEL(SDOE,0)
  1.  ;
  1.  ; -- update check-out completion
  1.  D EN^SDCOM(SDOE,SDMODE,SDHDL,.SDCOMPF)
  1.  ;
  1.  ; -- set visit change flag for event driver
  1.  D CHANGE^SDAMEVT4(.SDHDL,$P($G(^SCE(SDOE,0)),U,8),$G(@SDROOT@("VISIT CHANGE FLAGS")))
  1.  ;
  1.  ; -- get after values and invoke event driver
  1.  D EVT^SDAMEVT2(SDOE,$G(SDAEVT,7),SDHDL)
  1.  ;
  1.  ; -- cleanup event driver vars
  1.  D CLEAN^SDAMEVT(SDHDL)
  1. FILEQ Q SDOE
  1.  ;
  1. TYPE(SDOE,SDOEP) ; -- Get Appt Type
  1.  ;     Input:    SDOE  - Outpatient Encounter pointer
  1.  ;               SDOEP - Outpatient Parent Encounter pointer
  1.  ;    Output:  Appointment Type ^ reason for computer generated
  1.  ;
  1.  N SDD,SDD1,SDI,SDCP,SDOE0,SDATE,X1,X2,X,VAERR,VAEL,SDX,SDQ,SDATYPE
  1.  S SDCP=0
  1.  ;
  1.  ;--If SDOEP exists, use its appointment type
  1.  IF $G(SDOEP) S SDATYPE=$P($G(^SCE(SDOEP,0)),U,10) IF SDATYPE G TYPEQ
  1.  ;
  1.  ;--search last 3 days + today in Outpatient Encounter file
  1.  S SDOE0=$G(^SCE(SDOE,0)),SDATE=$P(+SDOE0,".")
  1.  S X1=SDATE,X2="-3" D C^%DTC S SDD1=X,SDD=SDD1-.1 K X,%H,X1,X2
  1.  F  S SDD=$O(^SCE("ADFN",DFN,SDD)) Q:'SDD!($P(SDD,".")>SDATE)!(SDCP)  D
  1.  . S SDI=0
  1.  . F  S SDI=$O(^SCE("ADFN",SDD,SDI)) Q:'SDI!(SDCP)  IF $P($G(^SCE(SDI,0)),U,10)=1 S SDCP=1
  1.  ;
  1.  ;;search last 3 days + today in Patient File
  1.  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
  1.  ;
  1.  I SDCP S SDATYPE=10 G TYPEQ
  1.  ;
  1.  ;if no comp and pen appts, try to determine based on eligibility
  1.  S SDATYPE=0 D ELIG^VADPT
  1.  I VAERR!'$G(VAEL(1)) S SDATYPE=10 G TYPEQ
  1.  S VAEL(1)=$P(^DIC(8,+VAEL(1),0),U,9)
  1.  S SDFLAG=$S(+VAEL(1)=9:8,+VAEL(1)=13:7,+VAEL(1)=14:4,1:0)
  1.  ; *** rebuild Elig array from VAEL(1,#) using pointers to MAS ELIGIBILITY CODE File,
  1.  ; #8.1,  Check for SHARING AGREEMENT (9), COLLATERAL OF VET. (13) or EMPLOYEE (14)
  1.  ;
  1.  I $D(VAEL(1))=11 D  G:$G(SDQ) TYPEQ
  1.  . N ELG
  1.  . S SDX=0 F  S SDX=$O(VAEL(1,SDX)) Q:'SDX  D
  1.  .. S ELG(+$P($G(^DIC(8,+VAEL(1,SDX),0)),U,9))=""
  1.  . I $D(ELG(9))!($D(ELG(13)))!($D(ELG(14)))!SDFLAG S SDATYPE=10,SDQ=1
  1.  ;
  1.  S SDATYPE=$S($D(VAEL(1))=1&(SDFLAG):SDFLAG,1:9)
  1.  ;
  1.  ; -- Appointment Type ^ reason for computer generated
  1. TYPEQ Q SDATYPE_U_$S(SDCP:2,SDATYPE=10:1,1:"")
  1.  ;