MBAAWLAP ;OIT-PD/CBR - WAIT LIST API ;02/13/2015
;;1.0;Scheduling Calendar View;**1**;Aug 27, 2014;Build 85
;
;Associated ICRs:
; ICR#
; 6051 MBAA SDWLE6 API
;
LOCK(RETURN,IEN) ;LOCK ^SDWL GLOBAL MBAA RPC: MBAA REMOVE FROM EWL
S RETURN=0
I '+$G(IEN) D Q 0
. D ERRX^MBAAAPIE(.RETURN,"INVPARAM","IEN")
S RETURN=$$LOCK^MBAAWLDA(IEN)
Q:RETURN 1
D ERRX^MBAAAPIE(.RETURN,"FILELOCK")
Q 0
;
UNLOCK(IEN) ; MBAA RPC: MBAA REMOVE FROM EWL
Q:'+$G(IEN) 0
Q $$UNLOCK^MBAAWLDA(IEN)
;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
;HASENTRY(RETURN,DFN) ;PATIENT HAS EWL ENTRIES?
; S RETURN=0
; I '+$G(DFN) D Q 0
; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","DFN")
; S RETURN=$$HASENTRY^MBAAWLDA(DFN)
; Q 1
; ;
;LIST(RETURN,DFN,STATUS,BEGIN,END) ;LIST PATIENT EWL ENTRIES
; N PATOK
; S RETURN=0
; I '+$G(DFN) D Q 0
; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","DFN")
; I '$$HASENTRY(.PATOK,DFN)!'PATOK D Q 0
; . D ERRX^MBAAAPIE(.RETURN,"PATNFND")
; S STATUS=$E($G(STATUS))
; S BEGIN=$G(BEGIN)
; S END=$G(END)
; D LIST^MBAAWLDA(.RETURN,DFN,STATUS,BEGIN,END)
; Q 1
;
DETAIL(RETURN,IEN) ; MBAA RPC: MBAA REMOVE FROM EWL
I '+$G(IEN) D Q 0
. D ERRX^MBAAAPIE(.RETURN,"INVPARAM","IEN")
K RETURN
D DETAIL^MBAAWLDA(.RETURN,IEN)
Q 1
;
;TRNDET(RETURN,SDWLIEN) ; Get transfer details for Electronic Wait List internal entry number
; ; Input: SDWLIEN: EWL IEN
; ; Output: RETURN("ACTIVE"): 0: no active transfer, 1: active transfer
; ; RETURN("INSTITUTION"): Institution name
; ; RETURN("STATION"): Station Number
; N HASENTRY
; S RETURN("ACTIVE")=0
; I '+$G(SDWLIEN) D Q 0
; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
; I '$$TRFRQACT^MBAAWLDA(SDWLIEN) Q 1
; S RETURN("ACTIVE")=1
; Q $$TRFRQDET^MBAAWLDA(.RETURN,SDWLIEN)
; Q 1
;
DISP(RETURN,SDWLDFN,SDWLIEN,SDWLDISP,SDWLAPPT) ;UPDATE DISPOSITION MBAA RPC: MBAA REMOVE FROM EWL
N DA,DIE,SDWLDUZ
S RETURN=0
I '+$G(SDWLIEN) D Q 0
. D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
I ($G(SDWLDISP)="")!("^D^NC^SA^CC^NN^ER^TR^CL^"'["^"_$G(SDWLDISP)) D Q 0
. D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLDISP")
S RETURN=$$DISP^MBAAWLDA(SDWLDFN,SDWLIEN,SDWLDISP,.SDWLAPPT)
;; OG ; SD*5.3*446 Inter-facility transfer.
;; OG ; SD*5.3*446 Inter-facility transfer.
Q RETURN
;
NEW(RETURN,SDWLD) ;CREATE NEW EWL ENTRY MBAA RPC: MBAA EWL NEW
;RETURN: RETURNS NEW ENTRY IEN
N PAT,TYP
K RETURN
S RETURN=0
I '$D(SDWLD) D Q 0
. D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLD")
I +$G(SDWLD("PATIENT"))'>0 D Q 0
. D ERRX^MBAAAPIE(.RETURN,"INVPARAM","PATIENT")
I '$$PATDET^MBAALEXT(.PAT,+SDWLD("PATIENT")) D Q 0
. D ERRX^MBAAAPIE(.RETURN,"PATNFND")
I +$G(SDWLD("INSTITUTION"))'>0 D Q 0
. D ERRX^MBAAAPIE(.RETURN,"INVPARAM","INSTITUTION")
S TYP=+$G(SDWLD("WLTYPE"))
I TYP'>0,TYP'<5 D Q 0
. D ERRX^MBAAAPIE(.RETURN,"INVPARAM","WLTYPE")
I (TYP=3)!(TYP=4),'$D(SDWLD("PRIORITY")) D Q 0
. D ERRX^MBAAAPIE(.RETURN,"INVPARAM","PRIORITY")
I (TYP=3)!(TYP=4),'$D(SDWLD("REQBY")) D Q 0
. D ERRX^MBAAAPIE(.RETURN,"INVPARAM","REQBY")
I (TYP=3)!(TYP=4),'$D(SDWLD("DSRDDT")) D Q 0
. D ERRX^MBAAAPIE(.RETURN,"INVPARAM","DSRDDT")
Q $$NEW^MBAAWLDA(.RETURN,.SDWLD)
;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
;UPDATE(RETURN,SDWLIEN,SDWLD) ;
; K RETURN
; S RETURN=0
; I +$G(SDWLIEN)'>0 D Q 0
; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
; I '+$D(SDWLD) D Q 0
; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLD")
; Q $$UPDATE^MBAAWLDA(.RETURN,SDWLIEN,.SDWLD)
; ;
;DELETE(RETURN,SDWLIEN) ;DELETE EWL ENTRY
; K RETURN
; S RETURN=0
; I +$G(SDWLIEN)'>0 D Q 0
; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
; Q $$DELETE^MBAAWLDA(.RETURN,SDWLIEN)
; ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMBAAWLAP 3931 printed Apr 09, 2024@21:16:48 Page 2
MBAAWLAP ;OIT-PD/CBR - WAIT LIST API ;02/13/2015
+1 ;;1.0;Scheduling Calendar View;**1**;Aug 27, 2014;Build 85
+2 ;
+3 ;Associated ICRs:
+4 ; ICR#
+5 ; 6051 MBAA SDWLE6 API
+6 ;
LOCK(RETURN,IEN) ;LOCK ^SDWL GLOBAL MBAA RPC: MBAA REMOVE FROM EWL
+1 SET RETURN=0
+2 IF '+$GET(IEN)
Begin DoDot:1
+3 DO ERRX^MBAAAPIE(.RETURN,"INVPARAM","IEN")
End DoDot:1
QUIT 0
+4 SET RETURN=$$LOCK^MBAAWLDA(IEN)
+5 if RETURN
QUIT 1
+6 DO ERRX^MBAAAPIE(.RETURN,"FILELOCK")
+7 QUIT 0
+8 ;
UNLOCK(IEN) ; MBAA RPC: MBAA REMOVE FROM EWL
+1 if '+$GET(IEN)
QUIT 0
+2 QUIT $$UNLOCK^MBAAWLDA(IEN)
+3 ;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
+4 ;HASENTRY(RETURN,DFN) ;PATIENT HAS EWL ENTRIES?
+5 ; S RETURN=0
+6 ; I '+$G(DFN) D Q 0
+7 ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","DFN")
+8 ; S RETURN=$$HASENTRY^MBAAWLDA(DFN)
+9 ; Q 1
+10 ; ;
+11 ;LIST(RETURN,DFN,STATUS,BEGIN,END) ;LIST PATIENT EWL ENTRIES
+12 ; N PATOK
+13 ; S RETURN=0
+14 ; I '+$G(DFN) D Q 0
+15 ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","DFN")
+16 ; I '$$HASENTRY(.PATOK,DFN)!'PATOK D Q 0
+17 ; . D ERRX^MBAAAPIE(.RETURN,"PATNFND")
+18 ; S STATUS=$E($G(STATUS))
+19 ; S BEGIN=$G(BEGIN)
+20 ; S END=$G(END)
+21 ; D LIST^MBAAWLDA(.RETURN,DFN,STATUS,BEGIN,END)
+22 ; Q 1
+23 ;
DETAIL(RETURN,IEN) ; MBAA RPC: MBAA REMOVE FROM EWL
+1 IF '+$GET(IEN)
Begin DoDot:1
+2 DO ERRX^MBAAAPIE(.RETURN,"INVPARAM","IEN")
End DoDot:1
QUIT 0
+3 KILL RETURN
+4 DO DETAIL^MBAAWLDA(.RETURN,IEN)
+5 QUIT 1
+6 ;
+7 ;TRNDET(RETURN,SDWLIEN) ; Get transfer details for Electronic Wait List internal entry number
+8 ; ; Input: SDWLIEN: EWL IEN
+9 ; ; Output: RETURN("ACTIVE"): 0: no active transfer, 1: active transfer
+10 ; ; RETURN("INSTITUTION"): Institution name
+11 ; ; RETURN("STATION"): Station Number
+12 ; N HASENTRY
+13 ; S RETURN("ACTIVE")=0
+14 ; I '+$G(SDWLIEN) D Q 0
+15 ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
+16 ; I '$$TRFRQACT^MBAAWLDA(SDWLIEN) Q 1
+17 ; S RETURN("ACTIVE")=1
+18 ; Q $$TRFRQDET^MBAAWLDA(.RETURN,SDWLIEN)
+19 ; Q 1
+20 ;
DISP(RETURN,SDWLDFN,SDWLIEN,SDWLDISP,SDWLAPPT) ;UPDATE DISPOSITION MBAA RPC: MBAA REMOVE FROM EWL
+1 NEW DA,DIE,SDWLDUZ
+2 SET RETURN=0
+3 IF '+$GET(SDWLIEN)
Begin DoDot:1
+4 DO ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
End DoDot:1
QUIT 0
+5 IF ($GET(SDWLDISP)="")!("^D^NC^SA^CC^NN^ER^TR^CL^"'["^"_$GET(SDWLDISP))
Begin DoDot:1
+6 DO ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLDISP")
End DoDot:1
QUIT 0
+7 SET RETURN=$$DISP^MBAAWLDA(SDWLDFN,SDWLIEN,SDWLDISP,.SDWLAPPT)
+8 ;; OG ; SD*5.3*446 Inter-facility transfer.
+9 ;; OG ; SD*5.3*446 Inter-facility transfer.
+10 QUIT RETURN
+11 ;
NEW(RETURN,SDWLD) ;CREATE NEW EWL ENTRY MBAA RPC: MBAA EWL NEW
+1 ;RETURN: RETURNS NEW ENTRY IEN
+2 NEW PAT,TYP
+3 KILL RETURN
+4 SET RETURN=0
+5 IF '$DATA(SDWLD)
Begin DoDot:1
+6 DO ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLD")
End DoDot:1
QUIT 0
+7 IF +$GET(SDWLD("PATIENT"))'>0
Begin DoDot:1
+8 DO ERRX^MBAAAPIE(.RETURN,"INVPARAM","PATIENT")
End DoDot:1
QUIT 0
+9 IF '$$PATDET^MBAALEXT(.PAT,+SDWLD("PATIENT"))
Begin DoDot:1
+10 DO ERRX^MBAAAPIE(.RETURN,"PATNFND")
End DoDot:1
QUIT 0
+11 IF +$GET(SDWLD("INSTITUTION"))'>0
Begin DoDot:1
+12 DO ERRX^MBAAAPIE(.RETURN,"INVPARAM","INSTITUTION")
End DoDot:1
QUIT 0
+13 SET TYP=+$GET(SDWLD("WLTYPE"))
+14 IF TYP'>0
IF TYP'<5
Begin DoDot:1
+15 DO ERRX^MBAAAPIE(.RETURN,"INVPARAM","WLTYPE")
End DoDot:1
QUIT 0
+16 IF (TYP=3)!(TYP=4)
IF '$DATA(SDWLD("PRIORITY"))
Begin DoDot:1
+17 DO ERRX^MBAAAPIE(.RETURN,"INVPARAM","PRIORITY")
End DoDot:1
QUIT 0
+18 IF (TYP=3)!(TYP=4)
IF '$DATA(SDWLD("REQBY"))
Begin DoDot:1
+19 DO ERRX^MBAAAPIE(.RETURN,"INVPARAM","REQBY")
End DoDot:1
QUIT 0
+20 IF (TYP=3)!(TYP=4)
IF '$DATA(SDWLD("DSRDDT"))
Begin DoDot:1
+21 DO ERRX^MBAAAPIE(.RETURN,"INVPARAM","DSRDDT")
End DoDot:1
QUIT 0
+22 QUIT $$NEW^MBAAWLDA(.RETURN,.SDWLD)
+23 ;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
+24 ;UPDATE(RETURN,SDWLIEN,SDWLD) ;
+25 ; K RETURN
+26 ; S RETURN=0
+27 ; I +$G(SDWLIEN)'>0 D Q 0
+28 ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
+29 ; I '+$D(SDWLD) D Q 0
+30 ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLD")
+31 ; Q $$UPDATE^MBAAWLDA(.RETURN,SDWLIEN,.SDWLD)
+32 ; ;
+33 ;DELETE(RETURN,SDWLIEN) ;DELETE EWL ENTRY
+34 ; K RETURN
+35 ; S RETURN=0
+36 ; I +$G(SDWLIEN)'>0 D Q 0
+37 ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
+38 ; Q $$DELETE^MBAAWLDA(.RETURN,SDWLIEN)
+39 ; ;
