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

MBAAWLAP.m

Go to the documentation of this file. 
  1. MBAAWLAP ;OIT-PD/CBR - WAIT LIST API ;02/13/2015
  1.  ;;1.0;Scheduling Calendar View;**1**;Aug 27, 2014;Build 85
  1.  ;
  1.  ;Associated ICRs:
  1.  ;  ICR#
  1.  ;  6051 MBAA SDWLE6 API
  1.  ;
  1. LOCK(RETURN,IEN) ;LOCK ^SDWL GLOBAL MBAA RPC: MBAA REMOVE FROM EWL
  1.  S RETURN=0
  1.  I '+$G(IEN) D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","IEN")
  1.  S RETURN=$$LOCK^MBAAWLDA(IEN)
  1.  Q:RETURN 1
  1.  D ERRX^MBAAAPIE(.RETURN,"FILELOCK")
  1.  Q 0
  1.  ;
  1. UNLOCK(IEN) ; MBAA RPC: MBAA REMOVE FROM EWL
  1.  Q:'+$G(IEN) 0
  1.  Q $$UNLOCK^MBAAWLDA(IEN)
  1.  ;code below is not being used in the initial release of MBAA. It will be released at a later date in a future release of MBAA
  1.  ;HASENTRY(RETURN,DFN) ;PATIENT HAS EWL ENTRIES?
  1.  ; S RETURN=0
  1.  ; I '+$G(DFN) D  Q 0
  1.  ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","DFN")
  1.  ; S RETURN=$$HASENTRY^MBAAWLDA(DFN)
  1.  ; Q 1
  1.  ; ;
  1.  ;LIST(RETURN,DFN,STATUS,BEGIN,END) ;LIST PATIENT EWL ENTRIES
  1.  ; N PATOK
  1.  ; S RETURN=0
  1.  ; I '+$G(DFN) D  Q 0
  1.  ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","DFN")
  1.  ; I '$$HASENTRY(.PATOK,DFN)!'PATOK D  Q 0
  1.  ; . D ERRX^MBAAAPIE(.RETURN,"PATNFND")
  1.  ; S STATUS=$E($G(STATUS))
  1.  ; S BEGIN=$G(BEGIN)
  1.  ; S END=$G(END)
  1.  ; D LIST^MBAAWLDA(.RETURN,DFN,STATUS,BEGIN,END)
  1.  ; Q 1
  1.  ;
  1. DETAIL(RETURN,IEN) ; MBAA RPC: MBAA REMOVE FROM EWL
  1.  I '+$G(IEN) D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","IEN")
  1.  K RETURN
  1.  D DETAIL^MBAAWLDA(.RETURN,IEN)
  1.  Q 1
  1.  ;
  1.  ;TRNDET(RETURN,SDWLIEN) ; Get transfer details for Electronic Wait List internal entry number
  1.  ; ; Input:   SDWLIEN:   EWL IEN
  1.  ; ; Output:  RETURN("ACTIVE"): 0: no active transfer, 1: active transfer
  1.  ; ;          RETURN("INSTITUTION"): Institution name
  1.  ; ;          RETURN("STATION"):  Station Number
  1.  ; N HASENTRY
  1.  ; S RETURN("ACTIVE")=0
  1.  ; I '+$G(SDWLIEN) D  Q 0
  1.  ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
  1.  ; I '$$TRFRQACT^MBAAWLDA(SDWLIEN) Q 1
  1.  ; S RETURN("ACTIVE")=1
  1.  ; Q $$TRFRQDET^MBAAWLDA(.RETURN,SDWLIEN)
  1.  ; Q 1
  1.  ;
  1. DISP(RETURN,SDWLDFN,SDWLIEN,SDWLDISP,SDWLAPPT) ;UPDATE DISPOSITION MBAA RPC: MBAA REMOVE FROM EWL
  1.  N DA,DIE,SDWLDUZ
  1.  S RETURN=0
  1.  I '+$G(SDWLIEN) D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
  1.  I ($G(SDWLDISP)="")!("^D^NC^SA^CC^NN^ER^TR^CL^"'["^"_$G(SDWLDISP)) D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLDISP")
  1.  S RETURN=$$DISP^MBAAWLDA(SDWLDFN,SDWLIEN,SDWLDISP,.SDWLAPPT)
  1.  ;; OG ; SD*5.3*446 Inter-facility transfer.
  1.  ;; OG ; SD*5.3*446 Inter-facility transfer.
  1.  Q RETURN
  1.  ;
  1. NEW(RETURN,SDWLD) ;CREATE NEW EWL ENTRY MBAA RPC: MBAA EWL NEW
  1.  ;RETURN: RETURNS NEW ENTRY IEN
  1.  N PAT,TYP
  1.  K RETURN
  1.  S RETURN=0
  1.  I '$D(SDWLD) D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLD")
  1.  I +$G(SDWLD("PATIENT"))'>0 D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","PATIENT")
  1.  I '$$PATDET^MBAALEXT(.PAT,+SDWLD("PATIENT")) D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"PATNFND")
  1.  I +$G(SDWLD("INSTITUTION"))'>0 D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","INSTITUTION")
  1.  S TYP=+$G(SDWLD("WLTYPE"))
  1.  I TYP'>0,TYP'<5  D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","WLTYPE")
  1.  I (TYP=3)!(TYP=4),'$D(SDWLD("PRIORITY")) D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","PRIORITY")
  1.  I (TYP=3)!(TYP=4),'$D(SDWLD("REQBY")) D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","REQBY")
  1.  I (TYP=3)!(TYP=4),'$D(SDWLD("DSRDDT")) D  Q 0
  1.  . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","DSRDDT")
  1.  Q $$NEW^MBAAWLDA(.RETURN,.SDWLD)
  1.  ;code below is not being used in the initial release of MBAA. It will be released at a later date in a future release of MBAA
  1.  ;UPDATE(RETURN,SDWLIEN,SDWLD) ;
  1.  ; K RETURN
  1.  ; S RETURN=0
  1.  ; I +$G(SDWLIEN)'>0 D  Q 0
  1.  ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
  1.  ; I '+$D(SDWLD) D  Q 0
  1.  ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLD")
  1.  ; Q $$UPDATE^MBAAWLDA(.RETURN,SDWLIEN,.SDWLD)
  1.  ; ;
  1.  ;DELETE(RETURN,SDWLIEN) ;DELETE EWL ENTRY
  1.  ; K RETURN
  1.  ; S RETURN=0
  1.  ; I +$G(SDWLIEN)'>0 D  Q 0
  1.  ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
  1.  ; Q $$DELETE^MBAAWLDA(.RETURN,SDWLIEN)
  1.  ; ;