MBAAWLDA ;OIT-PD/CBR - WAIT LIST API ;02/13/2015
;;1.0;Scheduling Calendar View;**1**;Aug 27, 2014;Build 85
;
;Associated ICRs:
; ICR#
; 6046 SDWL(409.3
; 10103 XLFDT
;
;Code below is scheduled for a future release of MBAA
LOCK(IEN,TIMEOUT) ;LOCK ^SDWL MBAA RPC: MBAA REMOVE FROM EWL
L +^SDWL(409.3,IEN):$G(TIMEOUT,5) ;ICR#: 6046 SDWL(409.3
Q $T
;
UNLOCK(IEN) ; MBAA RPC: MBAA REMOVE FROM EWL
L -^SDWL(409.3,IEN) ;ICR#: 6046 SDWL(409.3
Q 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
;HASENTRY(DFN) ;TRUE IF PATIENT HAS EWL ENTRIES ON FILE
; Q $D(^SDWL(409.3,"B",DFN))>0
; ;
;LIST(RETURN,DFN,STATUS,BEGIN,END) ;RETURNS LIST OF EWL ENTRIES FOR PATIENT
; N I,IENLST,IEN,SDWL,CNT,SCRSET,SCRIF,TYP,WF,WFN
; S RETURN=0
; S SDWL=409.3
; S CNT=0
; S SCRSET="",SCRIF="$P(^(0),U,3)'="""""
; S:STATUS'="" SCRIF=SCRIF_",$P(^(0),U,17)="""_STATUS_""""
; I BEGIN'="",END'="" D
; . S SCRSET="SDWLDT=$P(^(0),U,2)"
; . S SCRIF=SCRIF_",SDWLDT'<BEGIN,SDWLDT'>END"
; S SCRIF=$S(SCRSET="":"",1:"S "_SCRSET_" ")_"I "_SCRIF
; D FIND^DIC(SDWL,,"@","BXQ",DFN,,"B",SCRIF,,"IENLST","ERT")
; S RETURN=+$P(IENLST("DILIST",0),U)
; Q:'RETURN
; F I=1:1:RETURN D
; . N REC
; . S IEN=IENLST("DILIST",2,I)
; . D GETS^DIQ(SDWL,IEN,"1;2;4:8;10;21;23","IE","REC","ERT")
; . S TYP=REC(SDWL,IEN_",",4,"I")
; . S WF=$S("1234"[+TYP:REC(SDWL,IEN_",",TYP+4,"I"),1:"")
; . S WFN=$S("1234"[+TYP:REC(SDWL,IEN_",",TYP+4,"E"),1:"")
; . S RETURN(I,"IEN")=IEN
; . S RETURN(I,"ORIGDT")=REC(SDWL,IEN_",",1,"I")_"^"_REC(SDWL,IEN_",",1,"E")
; . S RETURN(I,"INSTITUTION")=REC(SDWL,IEN_",",2,"I")_"^"_REC(SDWL,IEN_",",2,"E")
; . S RETURN(I,"WLTYPE")=REC(SDWL,IEN_",",4,"I")_"^"_REC(SDWL,IEN_",",4,"E")
; . S RETURN(I,"PRIORITY")=REC(SDWL,IEN_",",10,"I")_"^"_REC(SDWL,IEN_",",10,"E")
; . S RETURN(I,"WAITFOR")=WF_"^"_WFN
; . S RETURN(I,"DISPTYPE")=REC(SDWL,IEN_",",21,"I")_"^"_REC(SDWL,IEN_",",21,"E")
; . S RETURN(I,"STATUS")=REC(SDWL,IEN_",",23,"I")_"^"_REC(SDWL,IEN_",",23,"E")
; Q
;
DETAIL(RETURN,IEN) ;RETURNS EWL ENTRY DETAILED DATA MBAA RPC: MBAA REMOVE FROM EWL
N SDWL,REC,TYP,WF,WFN
S SDWL=409.3
D GETS^DIQ(SDWL,IEN,".01:23;25;29;30;37","IE","REC","ERT")
S RETURN("PATIENT")=REC(SDWL,IEN_",",.01,"I")_"^"_REC(SDWL,IEN_",",.01,"E")
S RETURN("ORIGDT")=REC(SDWL,IEN_",",1,"I")_"^"_REC(SDWL,IEN_",",1,"E")
S RETURN("INSTITUTION")=REC(SDWL,IEN_",",2,"I")_"^"_REC(SDWL,IEN_",",2,"E")
S RETURN("WLTYPE")=REC(SDWL,IEN_",",4,"I")_"^"_REC(SDWL,IEN_",",4,"E")
S TYP=REC(SDWL,IEN_",",4,"I")
S WF=$S("1234"[+TYP:REC(SDWL,IEN_",",TYP+4,"I"),1:"")
S WFN=$S("1234"[+TYP:REC(SDWL,IEN_",",TYP+4,"E"),1:"")
S RETURN("WAITFOR")=WF_"^"_WFN
S:TYP=3 RETURN("WAITFORP")=$$GET1^DIQ(409.31,WF_",",.01,"I")_"^"_WFN
S:TYP=4 RETURN("WAITFORP")=$$GET1^DIQ(409.32,WF_",",.01,"I")_"^"_WFN
S RETURN("ENTEREDBY")=REC(SDWL,IEN_",",9,"I")_"^"_REC(SDWL,IEN_",",9,"E")
S RETURN("PRIORITY")=REC(SDWL,IEN_",",10,"I")_"^"_REC(SDWL,IEN_",",10,"E")
S RETURN("REQBY")=REC(SDWL,IEN_",",11,"I")_"^"_REC(SDWL,IEN_",",11,"E")
S RETURN("PROVIDER")=REC(SDWL,IEN_",",12,"I")_"^"_REC(SDWL,IEN_",",12,"E")
S RETURN("APPTSCHED")=REC(SDWL,IEN_",",13,"I")_"^"_REC(SDWL,IEN_",",13,"E")
S RETURN("APPTDATE")=REC(SDWL,IEN_",",13.1,"I")_"^"_REC(SDWL,IEN_",",13.1,"E")
S RETURN("APPTCLIN")=REC(SDWL,IEN_",",13.2,"I")_"^"_REC(SDWL,IEN_",",13.2,"E")
S RETURN("APPTINST")=REC(SDWL,IEN_",",13.3,"I")_"^"_REC(SDWL,IEN_",",13.3,"E")
S RETURN("APPTSC")=REC(SDWL,IEN_",",13.4,"I")_"^"_REC(SDWL,IEN_",",13.4,"E")
S RETURN("APPTCREDSC")=REC(SDWL,IEN_",",13.5,"I")_"^"_REC(SDWL,IEN_",",13.5,"E")
S RETURN("APPTSN")=REC(SDWL,IEN_",",13.6,"I")_"^"_REC(SDWL,IEN_",",13.6,"E")
S RETURN("APPTCLERK")=REC(SDWL,IEN_",",13.7,"I")_"^"_REC(SDWL,IEN_",",13.7,"E")
S RETURN("APPTSTATUS")=REC(SDWL,IEN_",",13.8,"I")_"^"_REC(SDWL,IEN_",",13.8,"E")
S RETURN("SCPRIORITY")=REC(SDWL,IEN_",",15,"I")_"^"_REC(SDWL,IEN_",",15,"E")
S RETURN("DNRDT")=REC(SDWL,IEN_",",16,"I")_"^"_$$FMTE^XLFDT(REC(SDWL,IEN_",",16,"I"),"2DZ") ;ICR#: 10103 XLFDT
S RETURN("DNRUSR")=REC(SDWL,IEN_",",17,"I")_"^"_REC(SDWL,IEN_",",17,"E")
S RETURN("DNRRSN")=REC(SDWL,IEN_",",18,"I")_"^"_REC(SDWL,IEN_",",18,"E")
S RETURN("DNRCMT")=REC(SDWL,IEN_",",18.1,"I")_"^"_REC(SDWL,IEN_",",18.1,"E")
S RETURN("DISPDT")=REC(SDWL,IEN_",",19,"I")_"^"_REC(SDWL,IEN_",",19,"E")
S RETURN("DISPBY")=REC(SDWL,IEN_",",20,"I")_"^"_REC(SDWL,IEN_",",20,"E")
S RETURN("DISPTYPE")=REC(SDWL,IEN_",",21,"I")_"^"_REC(SDWL,IEN_",",21,"E")
S RETURN("DSRDDT")=REC(SDWL,IEN_",",22,"I")_"^"_$$FMTE^XLFDT(REC(SDWL,IEN_",",22,"I"),"2DZ") ;ICR#: 10103 XLFDT
S RETURN("STATUS")=REC(SDWL,IEN_",",23,"I")_"^"_REC(SDWL,IEN_",",23,"E")
S RETURN("CMNTS")=REC(SDWL,IEN_",",25,"I")_"^"_REC(SDWL,IEN_",",25,"E")
S RETURN("REOPENRSN")=REC(SDWL,IEN_",",29,"I")_"^"_REC(SDWL,IEN_",",29,"E")
S RETURN("REOPENCMT")=REC(SDWL,IEN_",",30,"I")_"^"_REC(SDWL,IEN_",",30,"E")
S RETURN("CHDCLINP")=REC(SDWL,IEN_",",37,"I")_"^"_REC(SDWL,IEN_",",37,"E")
Q
;
DISP(SDWLDFN,SDWLIEN,SDWLDISP,SDA) ;UPDATE DISPOSITION MBAA RPC: MBAA REMOVE FROM EWL
N DA,DIE,DR,SDWLSS,SDWLSCL
S DIE="^SDWL(409.3," ;ICR#: 6046 SDWL(409.3
S DA=SDWLIEN
S DR="21///^S X=SDWLDISP" D ^DIE
S DR="19///^S X=DT" D ^DIE
S DR="20///^S X=DUZ" D ^DIE
S DR="23///^S X=""C""" D ^DIE
I SDWLDISP="SA",$D(SDA) D
. S DR="13///"_SDA(1)_";13.1///"_DT_";13.2///"_SDA(2)_";13.3///"_SDA(15)_";13.4///"_SDA(13)_";13.5///"_SDA(14)_";13.6///"_SDA(16)_";13.8///"_SDA(3)_";13.7///"_DUZ
. D ^DIE
S SDWLSS=$$GET1^DIQ(409.3,SDWLIEN_",",7,"I")
I SDWLSS K:$D(^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLIEN)) ^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLIEN) ;ICR#: 6046 SDWL(409.3
S SDWLSCL=$$GET1^DIQ(409.3,SDWLIEN_",",8,"I")
;S SDWLSCL="" I SDWLSC S SDWLSCL=+$P(^SDWL(409.32,SDWLSC,0),U,1)
I SDWLSCL K:$D(^SDWL(409.3,"SC",SDWLSCL,SDWLIEN)) ^SDWL(409.3,"SC",SDWLSCL,SDWLIEN) ;ICR#: 6046 SDWL(409.3
Q 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
;TRFRQACT(SDWLIEN) ;RETURNS 1 IF SDWLIEN HAS AN ACTIVE TRANSFER REQUEST
; Q $D(^SDWL(409.35,"B",SDWLIEN))
; ;
;TRFRQDET(RETURN,SDWLIEN) ;RETURNS TRANSFER REQUEST DETAILS
; N SDWLIFTN
; S SDWLIFTN=$O(^SDWL(409.35,"B",SDWLIEN,":"),-1)
; S RETURN("STATUS")=$$GET1^DIQ(409.35,SDWLIFTN,3,"I") ; Get the last transfer: a status of P, T or R can not have entries after.
; Q:"^P^T^R^"'[("^"_RETURN("STATUS")_"^") 0
; S RETURN("STATION")=$$GET1^DIQ(409.35,SDWLIFTN,1)
; S RETURN("INSTITUTION")=$$INSTFMST^MBAALEXT(RETURN("STATION"))
; Q 1
;
NEW(SDWLIEN,SDWLD) ;CREATES NEW ENTRY MBAA RPC: MBAA EWL NEW
N TYP,SDWL,FDA,IEN,MSG
S SDWL=409.3
S TYP=+SDWLD("WLTYPE")
S FDA(SDWL,"+1,",.01)=+SDWLD("PATIENT")
S FDA(SDWL,"+1,",1)=DT
S FDA(SDWL,"+1,",2)=+SDWLD("INSTITUTION")
S FDA(SDWL,"+1,",4)=TYP
S FDA(SDWL,"+1,",TYP+4)=+SDWLD("WAITFOR")
S FDA(SDWL,"+1,",9)=DUZ
I $D(SDWLD("PRIORITY")) S FDA(SDWL,"+1,",10)=$P(SDWLD("PRIORITY"),U)
I $D(SDWLD("REQBY")) S FDA(SDWL,"+1,",11)=+SDWLD("REQBY")
I $D(SDWLD("PROVIDER")) S FDA(SDWL,"+1,",12)=+SDWLD("PROVIDER")
I $D(SDWLD("SCPRCNT")) S FDA(SDWL,"+1,",14)=$P(SDWLD("SCPRCNT"),U)
I $D(SDWLD("SCPRIORITY")) S FDA(SDWL,"+1,",15)=$P(SDWLD("SCPRIORITY"),U)
I $D(SDWLD("DSRDDT")) S FDA(SDWL,"+1,",22)=$P(SDWLD("DSRDDT"),U)
S FDA(SDWL,"+1,",23)="O" ;RECORD STATUS = "OPEN"
I $D(SDWLD("CMNTS")) S FDA(SDWL,"+1,",25)=$P(SDWLD("CMNTS"),U)
I $D(SDWLD("ENRSTAT")) S FDA(SDWL,"+1,",27)=$P(SDWLD("ENRSTAT"),U)
I $D(SDWLD("ENRDU")) S FDA(SDWL,"+1,",27.1)=$P(SDWLD("ENRDU"),U)
I $D(SDWLD("ENRDF")) S FDA(SDWL,"+1,",27.2)=$P(SDWLD("ENRDF"),U)
S FDA(SDWL,"+1,",28)=DUZ
I $D(SDWLD("TICKLER")) S FDA(SDWL,"+1,",33)=$P(SDWLD("TICKLER"),U)
I $D(SDWLD("CHDCLINP")) S FDA(SDWL,"+1,",37)=$P(SDWLD("CHDCLINP"),U)
D UPDATE^DIE("","FDA","IEN","MSG")
I '$D(IEN) D Q 0
. D ERRX^MBAAAPIE(.SDWLIEN,"?","?")
S SDWLIEN=IEN(1)
Q 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
;UPDATE(RETURN,SDWLIEN,SDWLD) ;UPDATES AN EXISTING ENTRY
; N IEN,SDWL,FDA,MSG,TYP
; S RETURN=0
; S SDWL=409.3
; S IEN=SDWLIEN_","
; S FDA(SDWL,IEN,1)=DT
; S TYP=+$G(SDWL("WLTYPE"))
; I $D(SDWL("INSTITUTION")) S FDA(SDWL,IEN,2)=$P(SDWL("INSTITUTION"),U)
; I TYP>0,TYP<5 D
; . S FDA(SDWL,IEN,2)=TYP
; . I $D(SDWL("WAITFOR")) S FDA(SDWL,IEN,TYP+4)=$P(SDWL("WAITFOR"),U)
; ;S FDA(SDWL,IEN,9)=DUZ
; I $D(SDWLD("PRIORITY")) S FDA(SDWL,IEN,10)=$P(SDWLD("PRIORITY"),U)
; I $D(SDWLD("REQBY")) S FDA(SDWL,IEN,11)=+SDWLD("REQBY")
; I $D(SDWLD("PROVIDER")) S FDA(SDWL,IEN,12)=+SDWLD("PROVIDER")
; I $D(SDWLD("SCPRCNT")) S FDA(SDWL,IEN,14)=$P(SDWLD("SCPRCNT"),U)
; I $D(SDWLD("SCPRIORITY")) S FDA(SDWL,IEN,15)=$P(SDWLD("SCPRIORITY"),U)
; I $D(SDWLD("DSRDDT")) S FDA(SDWL,IEN,22)=$P(SDWLD("DSRDDT"),U)
; I $D(SDWLD("CMNTS")) S FDA(SDWL,IEN,25)=$P(SDWLD("CMNTS"),U)
; I $D(SDWLD("ENRSTAT")) S FDA(SDWL,IEN,27)=$P(SDWLD("ENRSTAT"),U)
; S FDA(SDWL,IEN,28)=DUZ
; I $D(SDWLD("REJECTED")) S FDA(SDWL,IEN,32)=$P(SDWLD("REJECTED"),U)
; I $D(SDWLD("TICKLER")) S FDA(SDWL,IEN,33)=$P(SDWLD("TICKLER"),U)
; I $D(SDWLD("INTRATF")) S FDA(SDWL,IEN,34)=$P(SDWLD("INTRATF"),U)
; I $D(SDWLD("MULTITEAM")) S FDA(SDWL,IEN,38)=$P(SDWLD("MULTITEAM"),U)
; D FILE^DIE("","FDA","MSG")
; I $D(MSG) D Q 0
; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLD")
; S RETURN=1
; Q 1
;
;DELETE(RETURN,SDWLIEN) ;
; N FDA,MSG
; S RETURN=0
; S FDA(409.3,SDWLIEN_",",.01)="@"
; D FILE^DIE("","FDA","MSG")
; I $D(MSG) D Q 0
; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
; S RETURN=1
; Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMBAAWLDA 9810 printed Apr 09, 2024@21:16:39 Page 2
MBAAWLDA ;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 ; 6046 SDWL(409.3
+6 ; 10103 XLFDT
+7 ;
+8 ;Code below is scheduled for a future release of MBAA
LOCK(IEN,TIMEOUT) ;LOCK ^SDWL MBAA RPC: MBAA REMOVE FROM EWL
+1 ;ICR#: 6046 SDWL(409.3
LOCK +^SDWL(409.3,IEN):$GET(TIMEOUT,5)
+2 QUIT $TEST
+3 ;
UNLOCK(IEN) ; MBAA RPC: MBAA REMOVE FROM EWL
+1 ;ICR#: 6046 SDWL(409.3
LOCK -^SDWL(409.3,IEN)
+2 QUIT 1
+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(DFN) ;TRUE IF PATIENT HAS EWL ENTRIES ON FILE
+5 ; Q $D(^SDWL(409.3,"B",DFN))>0
+6 ; ;
+7 ;LIST(RETURN,DFN,STATUS,BEGIN,END) ;RETURNS LIST OF EWL ENTRIES FOR PATIENT
+8 ; N I,IENLST,IEN,SDWL,CNT,SCRSET,SCRIF,TYP,WF,WFN
+9 ; S RETURN=0
+10 ; S SDWL=409.3
+11 ; S CNT=0
+12 ; S SCRSET="",SCRIF="$P(^(0),U,3)'="""""
+13 ; S:STATUS'="" SCRIF=SCRIF_",$P(^(0),U,17)="""_STATUS_""""
+14 ; I BEGIN'="",END'="" D
+15 ; . S SCRSET="SDWLDT=$P(^(0),U,2)"
+16 ; . S SCRIF=SCRIF_",SDWLDT'<BEGIN,SDWLDT'>END"
+17 ; S SCRIF=$S(SCRSET="":"",1:"S "_SCRSET_" ")_"I "_SCRIF
+18 ; D FIND^DIC(SDWL,,"@","BXQ",DFN,,"B",SCRIF,,"IENLST","ERT")
+19 ; S RETURN=+$P(IENLST("DILIST",0),U)
+20 ; Q:'RETURN
+21 ; F I=1:1:RETURN D
+22 ; . N REC
+23 ; . S IEN=IENLST("DILIST",2,I)
+24 ; . D GETS^DIQ(SDWL,IEN,"1;2;4:8;10;21;23","IE","REC","ERT")
+25 ; . S TYP=REC(SDWL,IEN_",",4,"I")
+26 ; . S WF=$S("1234"[+TYP:REC(SDWL,IEN_",",TYP+4,"I"),1:"")
+27 ; . S WFN=$S("1234"[+TYP:REC(SDWL,IEN_",",TYP+4,"E"),1:"")
+28 ; . S RETURN(I,"IEN")=IEN
+29 ; . S RETURN(I,"ORIGDT")=REC(SDWL,IEN_",",1,"I")_"^"_REC(SDWL,IEN_",",1,"E")
+30 ; . S RETURN(I,"INSTITUTION")=REC(SDWL,IEN_",",2,"I")_"^"_REC(SDWL,IEN_",",2,"E")
+31 ; . S RETURN(I,"WLTYPE")=REC(SDWL,IEN_",",4,"I")_"^"_REC(SDWL,IEN_",",4,"E")
+32 ; . S RETURN(I,"PRIORITY")=REC(SDWL,IEN_",",10,"I")_"^"_REC(SDWL,IEN_",",10,"E")
+33 ; . S RETURN(I,"WAITFOR")=WF_"^"_WFN
+34 ; . S RETURN(I,"DISPTYPE")=REC(SDWL,IEN_",",21,"I")_"^"_REC(SDWL,IEN_",",21,"E")
+35 ; . S RETURN(I,"STATUS")=REC(SDWL,IEN_",",23,"I")_"^"_REC(SDWL,IEN_",",23,"E")
+36 ; Q
+37 ;
DETAIL(RETURN,IEN) ;RETURNS EWL ENTRY DETAILED DATA MBAA RPC: MBAA REMOVE FROM EWL
+1 NEW SDWL,REC,TYP,WF,WFN
+2 SET SDWL=409.3
+3 DO GETS^DIQ(SDWL,IEN,".01:23;25;29;30;37","IE","REC","ERT")
+4 SET RETURN("PATIENT")=REC(SDWL,IEN_",",.01,"I")_"^"_REC(SDWL,IEN_",",.01,"E")
+5 SET RETURN("ORIGDT")=REC(SDWL,IEN_",",1,"I")_"^"_REC(SDWL,IEN_",",1,"E")
+6 SET RETURN("INSTITUTION")=REC(SDWL,IEN_",",2,"I")_"^"_REC(SDWL,IEN_",",2,"E")
+7 SET RETURN("WLTYPE")=REC(SDWL,IEN_",",4,"I")_"^"_REC(SDWL,IEN_",",4,"E")
+8 SET TYP=REC(SDWL,IEN_",",4,"I")
+9 SET WF=$SELECT("1234"[+TYP:REC(SDWL,IEN_",",TYP+4,"I"),1:"")
+10 SET WFN=$SELECT("1234"[+TYP:REC(SDWL,IEN_",",TYP+4,"E"),1:"")
+11 SET RETURN("WAITFOR")=WF_"^"_WFN
+12 if TYP=3
SET RETURN("WAITFORP")=$$GET1^DIQ(409.31,WF_",",.01,"I")_"^"_WFN
+13 if TYP=4
SET RETURN("WAITFORP")=$$GET1^DIQ(409.32,WF_",",.01,"I")_"^"_WFN
+14 SET RETURN("ENTEREDBY")=REC(SDWL,IEN_",",9,"I")_"^"_REC(SDWL,IEN_",",9,"E")
+15 SET RETURN("PRIORITY")=REC(SDWL,IEN_",",10,"I")_"^"_REC(SDWL,IEN_",",10,"E")
+16 SET RETURN("REQBY")=REC(SDWL,IEN_",",11,"I")_"^"_REC(SDWL,IEN_",",11,"E")
+17 SET RETURN("PROVIDER")=REC(SDWL,IEN_",",12,"I")_"^"_REC(SDWL,IEN_",",12,"E")
+18 SET RETURN("APPTSCHED")=REC(SDWL,IEN_",",13,"I")_"^"_REC(SDWL,IEN_",",13,"E")
+19 SET RETURN("APPTDATE")=REC(SDWL,IEN_",",13.1,"I")_"^"_REC(SDWL,IEN_",",13.1,"E")
+20 SET RETURN("APPTCLIN")=REC(SDWL,IEN_",",13.2,"I")_"^"_REC(SDWL,IEN_",",13.2,"E")
+21 SET RETURN("APPTINST")=REC(SDWL,IEN_",",13.3,"I")_"^"_REC(SDWL,IEN_",",13.3,"E")
+22 SET RETURN("APPTSC")=REC(SDWL,IEN_",",13.4,"I")_"^"_REC(SDWL,IEN_",",13.4,"E")
+23 SET RETURN("APPTCREDSC")=REC(SDWL,IEN_",",13.5,"I")_"^"_REC(SDWL,IEN_",",13.5,"E")
+24 SET RETURN("APPTSN")=REC(SDWL,IEN_",",13.6,"I")_"^"_REC(SDWL,IEN_",",13.6,"E")
+25 SET RETURN("APPTCLERK")=REC(SDWL,IEN_",",13.7,"I")_"^"_REC(SDWL,IEN_",",13.7,"E")
+26 SET RETURN("APPTSTATUS")=REC(SDWL,IEN_",",13.8,"I")_"^"_REC(SDWL,IEN_",",13.8,"E")
+27 SET RETURN("SCPRIORITY")=REC(SDWL,IEN_",",15,"I")_"^"_REC(SDWL,IEN_",",15,"E")
+28 ;ICR#: 10103 XLFDT
SET RETURN("DNRDT")=REC(SDWL,IEN_",",16,"I")_"^"_$$FMTE^XLFDT(REC(SDWL,IEN_",",16,"I"),"2DZ")
+29 SET RETURN("DNRUSR")=REC(SDWL,IEN_",",17,"I")_"^"_REC(SDWL,IEN_",",17,"E")
+30 SET RETURN("DNRRSN")=REC(SDWL,IEN_",",18,"I")_"^"_REC(SDWL,IEN_",",18,"E")
+31 SET RETURN("DNRCMT")=REC(SDWL,IEN_",",18.1,"I")_"^"_REC(SDWL,IEN_",",18.1,"E")
+32 SET RETURN("DISPDT")=REC(SDWL,IEN_",",19,"I")_"^"_REC(SDWL,IEN_",",19,"E")
+33 SET RETURN("DISPBY")=REC(SDWL,IEN_",",20,"I")_"^"_REC(SDWL,IEN_",",20,"E")
+34 SET RETURN("DISPTYPE")=REC(SDWL,IEN_",",21,"I")_"^"_REC(SDWL,IEN_",",21,"E")
+35 ;ICR#: 10103 XLFDT
SET RETURN("DSRDDT")=REC(SDWL,IEN_",",22,"I")_"^"_$$FMTE^XLFDT(REC(SDWL,IEN_",",22,"I"),"2DZ")
+36 SET RETURN("STATUS")=REC(SDWL,IEN_",",23,"I")_"^"_REC(SDWL,IEN_",",23,"E")
+37 SET RETURN("CMNTS")=REC(SDWL,IEN_",",25,"I")_"^"_REC(SDWL,IEN_",",25,"E")
+38 SET RETURN("REOPENRSN")=REC(SDWL,IEN_",",29,"I")_"^"_REC(SDWL,IEN_",",29,"E")
+39 SET RETURN("REOPENCMT")=REC(SDWL,IEN_",",30,"I")_"^"_REC(SDWL,IEN_",",30,"E")
+40 SET RETURN("CHDCLINP")=REC(SDWL,IEN_",",37,"I")_"^"_REC(SDWL,IEN_",",37,"E")
+41 QUIT
+42 ;
DISP(SDWLDFN,SDWLIEN,SDWLDISP,SDA) ;UPDATE DISPOSITION MBAA RPC: MBAA REMOVE FROM EWL
+1 NEW DA,DIE,DR,SDWLSS,SDWLSCL
+2 ;ICR#: 6046 SDWL(409.3
SET DIE="^SDWL(409.3,"
+3 SET DA=SDWLIEN
+4 SET DR="21///^S X=SDWLDISP"
DO ^DIE
+5 SET DR="19///^S X=DT"
DO ^DIE
+6 SET DR="20///^S X=DUZ"
DO ^DIE
+7 SET DR="23///^S X=""C"""
DO ^DIE
+8 IF SDWLDISP="SA"
IF $DATA(SDA)
Begin DoDot:1
+9 SET DR="13///"_SDA(1)_";13.1///"_DT_";13.2///"_SDA(2)_";13.3///"_SDA(15)_";13.4///"_SDA(13)_";13.5///"_SDA(14)_";13.6///"_SDA(16)_";13.8///"_SDA(3)_";13.7///"_DUZ
+10 DO ^DIE
End DoDot:1
+11 SET SDWLSS=$$GET1^DIQ(409.3,SDWLIEN_",",7,"I")
+12 ;ICR#: 6046 SDWL(409.3
IF SDWLSS
if $DATA(^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLIEN))
KILL ^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLIEN)
+13 SET SDWLSCL=$$GET1^DIQ(409.3,SDWLIEN_",",8,"I")
+14 ;S SDWLSCL="" I SDWLSC S SDWLSCL=+$P(^SDWL(409.32,SDWLSC,0),U,1)
+15 ;ICR#: 6046 SDWL(409.3
IF SDWLSCL
if $DATA(^SDWL(409.3,"SC",SDWLSCL,SDWLIEN))
KILL ^SDWL(409.3,"SC",SDWLSCL,SDWLIEN)
+16 QUIT 1
+17 ;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
+18 ;TRFRQACT(SDWLIEN) ;RETURNS 1 IF SDWLIEN HAS AN ACTIVE TRANSFER REQUEST
+19 ; Q $D(^SDWL(409.35,"B",SDWLIEN))
+20 ; ;
+21 ;TRFRQDET(RETURN,SDWLIEN) ;RETURNS TRANSFER REQUEST DETAILS
+22 ; N SDWLIFTN
+23 ; S SDWLIFTN=$O(^SDWL(409.35,"B",SDWLIEN,":"),-1)
+24 ; S RETURN("STATUS")=$$GET1^DIQ(409.35,SDWLIFTN,3,"I") ; Get the last transfer: a status of P, T or R can not have entries after.
+25 ; Q:"^P^T^R^"'[("^"_RETURN("STATUS")_"^") 0
+26 ; S RETURN("STATION")=$$GET1^DIQ(409.35,SDWLIFTN,1)
+27 ; S RETURN("INSTITUTION")=$$INSTFMST^MBAALEXT(RETURN("STATION"))
+28 ; Q 1
+29 ;
NEW(SDWLIEN,SDWLD) ;CREATES NEW ENTRY MBAA RPC: MBAA EWL NEW
+1 NEW TYP,SDWL,FDA,IEN,MSG
+2 SET SDWL=409.3
+3 SET TYP=+SDWLD("WLTYPE")
+4 SET FDA(SDWL,"+1,",.01)=+SDWLD("PATIENT")
+5 SET FDA(SDWL,"+1,",1)=DT
+6 SET FDA(SDWL,"+1,",2)=+SDWLD("INSTITUTION")
+7 SET FDA(SDWL,"+1,",4)=TYP
+8 SET FDA(SDWL,"+1,",TYP+4)=+SDWLD("WAITFOR")
+9 SET FDA(SDWL,"+1,",9)=DUZ
+10 IF $DATA(SDWLD("PRIORITY"))
SET FDA(SDWL,"+1,",10)=$PIECE(SDWLD("PRIORITY"),U)
+11 IF $DATA(SDWLD("REQBY"))
SET FDA(SDWL,"+1,",11)=+SDWLD("REQBY")
+12 IF $DATA(SDWLD("PROVIDER"))
SET FDA(SDWL,"+1,",12)=+SDWLD("PROVIDER")
+13 IF $DATA(SDWLD("SCPRCNT"))
SET FDA(SDWL,"+1,",14)=$PIECE(SDWLD("SCPRCNT"),U)
+14 IF $DATA(SDWLD("SCPRIORITY"))
SET FDA(SDWL,"+1,",15)=$PIECE(SDWLD("SCPRIORITY"),U)
+15 IF $DATA(SDWLD("DSRDDT"))
SET FDA(SDWL,"+1,",22)=$PIECE(SDWLD("DSRDDT"),U)
+16 ;RECORD STATUS = "OPEN"
SET FDA(SDWL,"+1,",23)="O"
+17 IF $DATA(SDWLD("CMNTS"))
SET FDA(SDWL,"+1,",25)=$PIECE(SDWLD("CMNTS"),U)
+18 IF $DATA(SDWLD("ENRSTAT"))
SET FDA(SDWL,"+1,",27)=$PIECE(SDWLD("ENRSTAT"),U)
+19 IF $DATA(SDWLD("ENRDU"))
SET FDA(SDWL,"+1,",27.1)=$PIECE(SDWLD("ENRDU"),U)
+20 IF $DATA(SDWLD("ENRDF"))
SET FDA(SDWL,"+1,",27.2)=$PIECE(SDWLD("ENRDF"),U)
+21 SET FDA(SDWL,"+1,",28)=DUZ
+22 IF $DATA(SDWLD("TICKLER"))
SET FDA(SDWL,"+1,",33)=$PIECE(SDWLD("TICKLER"),U)
+23 IF $DATA(SDWLD("CHDCLINP"))
SET FDA(SDWL,"+1,",37)=$PIECE(SDWLD("CHDCLINP"),U)
+24 DO UPDATE^DIE("","FDA","IEN","MSG")
+25 IF '$DATA(IEN)
Begin DoDot:1
+26 DO ERRX^MBAAAPIE(.SDWLIEN,"?","?")
End DoDot:1
QUIT 0
+27 SET SDWLIEN=IEN(1)
+28 QUIT 1
+29 ;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
+30 ;UPDATE(RETURN,SDWLIEN,SDWLD) ;UPDATES AN EXISTING ENTRY
+31 ; N IEN,SDWL,FDA,MSG,TYP
+32 ; S RETURN=0
+33 ; S SDWL=409.3
+34 ; S IEN=SDWLIEN_","
+35 ; S FDA(SDWL,IEN,1)=DT
+36 ; S TYP=+$G(SDWL("WLTYPE"))
+37 ; I $D(SDWL("INSTITUTION")) S FDA(SDWL,IEN,2)=$P(SDWL("INSTITUTION"),U)
+38 ; I TYP>0,TYP<5 D
+39 ; . S FDA(SDWL,IEN,2)=TYP
+40 ; . I $D(SDWL("WAITFOR")) S FDA(SDWL,IEN,TYP+4)=$P(SDWL("WAITFOR"),U)
+41 ; ;S FDA(SDWL,IEN,9)=DUZ
+42 ; I $D(SDWLD("PRIORITY")) S FDA(SDWL,IEN,10)=$P(SDWLD("PRIORITY"),U)
+43 ; I $D(SDWLD("REQBY")) S FDA(SDWL,IEN,11)=+SDWLD("REQBY")
+44 ; I $D(SDWLD("PROVIDER")) S FDA(SDWL,IEN,12)=+SDWLD("PROVIDER")
+45 ; I $D(SDWLD("SCPRCNT")) S FDA(SDWL,IEN,14)=$P(SDWLD("SCPRCNT"),U)
+46 ; I $D(SDWLD("SCPRIORITY")) S FDA(SDWL,IEN,15)=$P(SDWLD("SCPRIORITY"),U)
+47 ; I $D(SDWLD("DSRDDT")) S FDA(SDWL,IEN,22)=$P(SDWLD("DSRDDT"),U)
+48 ; I $D(SDWLD("CMNTS")) S FDA(SDWL,IEN,25)=$P(SDWLD("CMNTS"),U)
+49 ; I $D(SDWLD("ENRSTAT")) S FDA(SDWL,IEN,27)=$P(SDWLD("ENRSTAT"),U)
+50 ; S FDA(SDWL,IEN,28)=DUZ
+51 ; I $D(SDWLD("REJECTED")) S FDA(SDWL,IEN,32)=$P(SDWLD("REJECTED"),U)
+52 ; I $D(SDWLD("TICKLER")) S FDA(SDWL,IEN,33)=$P(SDWLD("TICKLER"),U)
+53 ; I $D(SDWLD("INTRATF")) S FDA(SDWL,IEN,34)=$P(SDWLD("INTRATF"),U)
+54 ; I $D(SDWLD("MULTITEAM")) S FDA(SDWL,IEN,38)=$P(SDWLD("MULTITEAM"),U)
+55 ; D FILE^DIE("","FDA","MSG")
+56 ; I $D(MSG) D Q 0
+57 ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLD")
+58 ; S RETURN=1
+59 ; Q 1
+60 ;
+61 ;DELETE(RETURN,SDWLIEN) ;
+62 ; N FDA,MSG
+63 ; S RETURN=0
+64 ; S FDA(409.3,SDWLIEN_",",.01)="@"
+65 ; D FILE^DIE("","FDA","MSG")
+66 ; I $D(MSG) D Q 0
+67 ; . D ERRX^MBAAAPIE(.RETURN,"INVPARAM","SDWLIEN")
+68 ; S RETURN=1
+69 ; Q 1
+70 ;
