MBAAMDA2 ;OIT-PD/VSL - APPOINTMENT API ;02/10/2016
;;1.0;Scheduling Calendar View;**1,5,7**;Feb 13, 2015;Build 16
;
;Associated ICRs
; ICR#
; 6053 DPT
; 6044 SC(
;
;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
;FRSTAVBL(RETURN,SC) ; Get first available date
; S RETURN=$O(^SC(+SC,"T",0))
; S RETURN=$O(^(0))
; Q
; ;
SLOTS(RETURN,SC,SD) ; Get available slots MBAA RPC: MBAA GET CLINIC AVAILABILITY
; RETURN - RETURN array passed in by reference
; SC - scheduling clinic IEN of File #44
; SD - starting date for slots - use DT if not passed in
;
;WCJ;MBAA*1*7; Start with either a date passed in or today.
I '$G(SD) S SD=DT
S SD=$$FMADD^XLFDT($P(SD,"."),-1,0,0,0)
;
F S SD=$O(^SC(SC,"ST",SD)) Q:SD'>0 D ;ICR#: 6044 SC(
.N IENS,ARRAY,ERR
.S IENS=$G(SD)_","_SC_","
.D GETS^DIQ(44.005,IENS,".01;1","I","ARRAY","ERR")
.S RETURN(SD,0)=$G(ARRAY(44.005,IENS,.01,"I"))
.S RETURN(SD,1)=$G(ARRAY(44.005,IENS,1,"I"))
.I $E(RETURN(SD,1),6,11)=" " S $E(RETURN(SD,1),6,11)=" " Q ;MBAA*1*5 - 10 MINS SLOTS
.I $E(RETURN(SD,1),6)'=" " S RETURN(SD,1)=$E(RETURN(SD,1),1,5)_" "_$E(RETURN(SD,1),6,99) ;MBAA*1*5 20 MINS SLOTS
;
;K SD
;M RETURN=^SC(+SC,"ST") ;ICR#: 6044 SC(
Q
;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
;SCEXST(RETURN,CSC) ; Returns Outpatient Classification Stop Code Exception status
; N FILE,STOPN,IENACT,FLDS,FS
; S STOPN=$$GET1^DIQ(40.7,+CSC_",",1)
; S IENACT=""
; S IENACT=$O(^SD(409.45,"B",STOPN,IENACT))
; S FILE="409.45"
; S FLDS("*")=""
; S FS("75")="",FS("75","F")="409.4575",FS("75","N")="EFFECTIVE DATE"
; S RETURN=0
; I $D(IENACT) D
; . D GETREC^MBAAMDAL(.RETURN,IENACT,FILE,.FLDS,.FS,1,1,1) S RETURN=1
; Q
; ;
LSTAPPT(RETURN,SEARCH,START,NUMBER) ; Lists appointment types MBAA RPC: MBAA APPOINTMENT LIST BY NAME
N FILE,FIELDS,RET
S FILE="409.1",FIELDS="@;.01"
S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"B","","","RETURN")
Q
;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
;GETAPPT(RETURN,TYPE,INT,EXT,REZ) ; Get Appointment Type
; N FILE,FLDS,SF
; S FILE=409.1,FLDS("*")=""
; D GETREC^MBAAMDAL(.RETURN,TYPE,FILE,.FLDS,.SF,$G(INT),$G(EXT),$G(REZ))
; Q
;
;GETELIG(RETURN,ELIG,INT,EXT,REZ) ; Get eligibility code
;N FILE,FLDS
;S FILE=8,FLDS("*")=""
;D GETREC^MBAAMDAL(.RETURN,ELIG,FILE,.FLDS,,$G(INT),$G(EXT),$G(REZ))
;Q
; ;
;HASPEND(RETURN,PAT,DT) ; Return 1 if patient has pending appointment
; S RETURN=0
; I '$D(^DPT(+$G(PAT),0)) D ERRX^MBAAAPIE(.RETURN,"PATNFND") Q RETURN
; S:$O(^DPT(PAT,"S",DT))>DT RETURN=1
; Q RETURN
; ;
;GETPEND(RETURN,PAT,DT) ; Get pending appointments
; N Y,AP
; F Y=DT:0 S Y=$O(^DPT(PAT,"S",Y)) Q:Y'>0 D
; . S AP=^(Y,0)
; . I "I"[$P(AP,U,2) D
; . . S RETURN(Y,.01)=$P(AP,U,1)
; . . S RETURN(Y,13)=$P(AP,U,11)
; . . S RETURN(Y,9.5)=$P(AP,U,16)
; . . S RETURN(Y,2)=$P(AP,U,3)
; . . S RETURN(Y,3)=$P(AP,U,4)
; . . S RETURN(Y,4)=$P(AP,U,5)
; Q
; ;
APTYNAME(TYPE) ; Get appointment type name MBAA RPC: MBAA PATIENT PENDING APPT
Q $$GET1^DIQ(409.1,TYPE_",",.01)
;
GETAPTS(RETURN,DFN,SD) ; Get patient appointments Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
;INPUT
; RETURN - by reference for results being RETURNed
; DFN - IEN to PATIENT (#2) file
; SD - FileMan Date time if you want information on a specific appointment
;
N FILE,SFILES,TMPDT
S FILE=2
S SFILES("1900")="",SFILES("1900","N")="APT",SFILES("1900","F")="2.98"
D GETREC^MBAAMDAL(.RETURN,DFN,FILE,,.SFILES,1,1,1,$G(SD))
Q
;
; Placed Quit above
; it would only get here if called from future functionality SCHED^MBAAAPI1
; replaced code altering DT to use TMPDT - otherwise a violation of SAC
S TMPDT=$S(SD(0)=1:$P(SD,"."),SD(0)=0:$O(APTS("APT","")))
F S TMPDT=$O(APTS("APT",TMPDT)) Q:TMPDT="" D
. M RETURN("APT",TMPDT)=APTS("APT",TMPDT)
Q
;
GETDAPTS(RETURN,DFN,SD) ; Get all appointments in the day Called by RPC MBAA APPOINTMENT MAKE
N NOD
S RETURN=0
S IND=$P(SD,".")
F S IND=$O(^DPT(DFN,"S",IND)) Q:IND=""!($P(IND,".")>$P(SD,".")) D ;ICR#: 6053 DPT
. ;T13 Change to use FM to get these fields
. N ARRAY S IENS=$G(SD)_","_$G(DFN)_"," D GETS^DIQ(2.98,IENS,".01;3","I","ARRAY")
. S RETURN(IND,1)=$G(ARRAY(2.98,IENS,.01,"I"))
. S RETURN(IND,2)=$G(ARRAY(2.98,IENS,3,"I"))
S RETURN=1
Q
;
LSTCRSNS(RETURN,SEARCH,START,NUMBER) ; MBAA RPC: MBAA LIST CANCELLATION REASONS
N FILE,FIELDS,RET,SCR,TYP
S FILE="409.2",FIELDS="@;.01"
S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
;T16 Change to return only cancel reasons that a patient can select
;I $D(RETURN("TYPE")) S TYP=RETURN("TYPE"),SCR="I $P(^(0),U,2)[""PB""&'$P(^(0),U,4),(TYP_""B""[$P(^(0),U,2))"
I $D(RETURN("TYPE")) S TYP=RETURN("TYPE")
S SCR="I ""BP""[$P(^(0),U,2)"
K RETURN
D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"B",.SCR,"","RETURN","ERR")
Q
;
LSTCSTA1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow cancellation. MBAA RPC: MBAA CANCEL APPOINTMENT
N FILE,FIELDS,RET,SCR
S FILE="409.63",FIELDS="@;.01"
S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
S START(1)=1
S START(2)=0
D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"ACAN",.SCR,"","RETURN","ERR")
Q
;
LSTCIST1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow check in. MBAA RPC: MBAA APPOINTMENT MAKE
N FILE,FIELDS,RET,SCR
S FILE="409.63",FIELDS="@;.01"
S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
S START(1)=1
S START(2)=0
D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"ACI",.SCR,"","RETURN","ERR")
Q
;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
;LSTCOST1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow check in.
; N FILE,FIELDS,RET,SCR
; S FILE="409.63",FIELDS="@;.01"
; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
; S START(1)=1
; S START(2)=0
; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"ACO",.SCR,"","RETURN","ERR")
; Q
;
;LSTNSTA1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow no-show.
;N FILE,FIELDS,RET,SCR
;S FILE="409.63",FIELDS="@;.01"
;S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
;S START(1)=1
;S START(2)=0
;D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"ANS",,"","RETURN","ERR")
;Q
;
GETAPT0(DFN,SD) ; Get appointment 0 node MBAA RPC: MBAA CANCEL APPOINTMENT
Q $G(^DPT(DFN,"S",SD,0)) ;ICR#: 6053 DPT
;
GETPAPT(RETURN,DFN,SD) ; Get patient appointment Called by RPC MBAA APPOINTMENT MAKE
; MBAA*1*7;WCJ;Seems like it would more efficient to string them all together and make one GETS^DIQ call, just saying
N IND
F IND=0:0 S IND=$O(RETURN(IND)) Q:IND="" D
. S RETURN(IND)=$$GET1^DIQ(2.98,SD_","_DFN_",",IND,"I")
S RETURN=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMBAAMDA2 7172 printed Oct 16, 2024@18:15:37 Page 2
MBAAMDA2 ;OIT-PD/VSL - APPOINTMENT API ;02/10/2016
+1 ;;1.0;Scheduling Calendar View;**1,5,7**;Feb 13, 2015;Build 16
+2 ;
+3 ;Associated ICRs
+4 ; ICR#
+5 ; 6053 DPT
+6 ; 6044 SC(
+7 ;
+8 ;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
+9 ;FRSTAVBL(RETURN,SC) ; Get first available date
+10 ; S RETURN=$O(^SC(+SC,"T",0))
+11 ; S RETURN=$O(^(0))
+12 ; Q
+13 ; ;
SLOTS(RETURN,SC,SD) ; Get available slots MBAA RPC: MBAA GET CLINIC AVAILABILITY
+1 ; RETURN - RETURN array passed in by reference
+2 ; SC - scheduling clinic IEN of File #44
+3 ; SD - starting date for slots - use DT if not passed in
+4 ;
+5 ;WCJ;MBAA*1*7; Start with either a date passed in or today.
+6 IF '$GET(SD)
SET SD=DT
+7 SET SD=$$FMADD^XLFDT($PIECE(SD,"."),-1,0,0,0)
+8 ;
+9 ;ICR#: 6044 SC(
FOR
SET SD=$ORDER(^SC(SC,"ST",SD))
if SD'>0
QUIT
Begin DoDot:1
+10 NEW IENS,ARRAY,ERR
+11 SET IENS=$GET(SD)_","_SC_","
+12 DO GETS^DIQ(44.005,IENS,".01;1","I","ARRAY","ERR")
+13 SET RETURN(SD,0)=$GET(ARRAY(44.005,IENS,.01,"I"))
+14 SET RETURN(SD,1)=$GET(ARRAY(44.005,IENS,1,"I"))
+15 ;MBAA*1*5 - 10 MINS SLOTS
IF $EXTRACT(RETURN(SD,1),6,11)=" "
SET $EXTRACT(RETURN(SD,1),6,11)=" "
QUIT
+16 ;MBAA*1*5 20 MINS SLOTS
IF $EXTRACT(RETURN(SD,1),6)'=" "
SET RETURN(SD,1)=$EXTRACT(RETURN(SD,1),1,5)_" "_$EXTRACT(RETURN(SD,1),6,99)
End DoDot:1
+17 ;
+18 ;K SD
+19 ;M RETURN=^SC(+SC,"ST") ;ICR#: 6044 SC(
+20 QUIT
+21 ;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
+22 ;SCEXST(RETURN,CSC) ; Returns Outpatient Classification Stop Code Exception status
+23 ; N FILE,STOPN,IENACT,FLDS,FS
+24 ; S STOPN=$$GET1^DIQ(40.7,+CSC_",",1)
+25 ; S IENACT=""
+26 ; S IENACT=$O(^SD(409.45,"B",STOPN,IENACT))
+27 ; S FILE="409.45"
+28 ; S FLDS("*")=""
+29 ; S FS("75")="",FS("75","F")="409.4575",FS("75","N")="EFFECTIVE DATE"
+30 ; S RETURN=0
+31 ; I $D(IENACT) D
+32 ; . D GETREC^MBAAMDAL(.RETURN,IENACT,FILE,.FLDS,.FS,1,1,1) S RETURN=1
+33 ; Q
+34 ; ;
LSTAPPT(RETURN,SEARCH,START,NUMBER) ; Lists appointment types MBAA RPC: MBAA APPOINTMENT LIST BY NAME
+1 NEW FILE,FIELDS,RET
+2 SET FILE="409.1"
SET FIELDS="@;.01"
+3 if $DATA(START)=0
SET START=""
if $DATA(SEARCH)=0
SET SEARCH=""
+4 DO LIST^DIC(FILE,"",FIELDS,"",$GET(NUMBER),.START,SEARCH,"B","","","RETURN")
+5 QUIT
+6 ;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
+7 ;GETAPPT(RETURN,TYPE,INT,EXT,REZ) ; Get Appointment Type
+8 ; N FILE,FLDS,SF
+9 ; S FILE=409.1,FLDS("*")=""
+10 ; D GETREC^MBAAMDAL(.RETURN,TYPE,FILE,.FLDS,.SF,$G(INT),$G(EXT),$G(REZ))
+11 ; Q
+12 ;
+13 ;GETELIG(RETURN,ELIG,INT,EXT,REZ) ; Get eligibility code
+14 ;N FILE,FLDS
+15 ;S FILE=8,FLDS("*")=""
+16 ;D GETREC^MBAAMDAL(.RETURN,ELIG,FILE,.FLDS,,$G(INT),$G(EXT),$G(REZ))
+17 ;Q
+18 ; ;
+19 ;HASPEND(RETURN,PAT,DT) ; Return 1 if patient has pending appointment
+20 ; S RETURN=0
+21 ; I '$D(^DPT(+$G(PAT),0)) D ERRX^MBAAAPIE(.RETURN,"PATNFND") Q RETURN
+22 ; S:$O(^DPT(PAT,"S",DT))>DT RETURN=1
+23 ; Q RETURN
+24 ; ;
+25 ;GETPEND(RETURN,PAT,DT) ; Get pending appointments
+26 ; N Y,AP
+27 ; F Y=DT:0 S Y=$O(^DPT(PAT,"S",Y)) Q:Y'>0 D
+28 ; . S AP=^(Y,0)
+29 ; . I "I"[$P(AP,U,2) D
+30 ; . . S RETURN(Y,.01)=$P(AP,U,1)
+31 ; . . S RETURN(Y,13)=$P(AP,U,11)
+32 ; . . S RETURN(Y,9.5)=$P(AP,U,16)
+33 ; . . S RETURN(Y,2)=$P(AP,U,3)
+34 ; . . S RETURN(Y,3)=$P(AP,U,4)
+35 ; . . S RETURN(Y,4)=$P(AP,U,5)
+36 ; Q
+37 ; ;
APTYNAME(TYPE) ; Get appointment type name MBAA RPC: MBAA PATIENT PENDING APPT
+1 QUIT $$GET1^DIQ(409.1,TYPE_",",.01)
+2 ;
GETAPTS(RETURN,DFN,SD) ; Get patient appointments Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
+1 ;INPUT
+2 ; RETURN - by reference for results being RETURNed
+3 ; DFN - IEN to PATIENT (#2) file
+4 ; SD - FileMan Date time if you want information on a specific appointment
+5 ;
+6 NEW FILE,SFILES,TMPDT
+7 SET FILE=2
+8 SET SFILES("1900")=""
SET SFILES("1900","N")="APT"
SET SFILES("1900","F")="2.98"
+9 DO GETREC^MBAAMDAL(.RETURN,DFN,FILE,,.SFILES,1,1,1,$GET(SD))
+10 QUIT
+11 ;
+12 ; Placed Quit above
+13 ; it would only get here if called from future functionality SCHED^MBAAAPI1
+14 ; replaced code altering DT to use TMPDT - otherwise a violation of SAC
+15 SET TMPDT=$SELECT(SD(0)=1:$PIECE(SD,"."),SD(0)=0:$ORDER(APTS("APT","")))
+16 FOR
SET TMPDT=$ORDER(APTS("APT",TMPDT))
if TMPDT=""
QUIT
Begin DoDot:1
+17 MERGE RETURN("APT",TMPDT)=APTS("APT",TMPDT)
End DoDot:1
+18 QUIT
+19 ;
GETDAPTS(RETURN,DFN,SD) ; Get all appointments in the day Called by RPC MBAA APPOINTMENT MAKE
+1 NEW NOD
+2 SET RETURN=0
+3 SET IND=$PIECE(SD,".")
+4 ;ICR#: 6053 DPT
FOR
SET IND=$ORDER(^DPT(DFN,"S",IND))
if IND=""!($PIECE(IND,".")>$PIECE(SD,"."))
QUIT
Begin DoDot:1
+5 ;T13 Change to use FM to get these fields
+6 NEW ARRAY
SET IENS=$GET(SD)_","_$GET(DFN)_","
DO GETS^DIQ(2.98,IENS,".01;3","I","ARRAY")
+7 SET RETURN(IND,1)=$GET(ARRAY(2.98,IENS,.01,"I"))
+8 SET RETURN(IND,2)=$GET(ARRAY(2.98,IENS,3,"I"))
End DoDot:1
+9 SET RETURN=1
+10 QUIT
+11 ;
LSTCRSNS(RETURN,SEARCH,START,NUMBER) ; MBAA RPC: MBAA LIST CANCELLATION REASONS
+1 NEW FILE,FIELDS,RET,SCR,TYP
+2 SET FILE="409.2"
SET FIELDS="@;.01"
+3 if $DATA(START)=0
SET START=""
if $DATA(SEARCH)=0
SET SEARCH=""
+4 ;T16 Change to return only cancel reasons that a patient can select
+5 ;I $D(RETURN("TYPE")) S TYP=RETURN("TYPE"),SCR="I $P(^(0),U,2)[""PB""&'$P(^(0),U,4),(TYP_""B""[$P(^(0),U,2))"
+6 IF $DATA(RETURN("TYPE"))
SET TYP=RETURN("TYPE")
+7 SET SCR="I ""BP""[$P(^(0),U,2)"
+8 KILL RETURN
+9 DO LIST^DIC(FILE,"",FIELDS,"",$GET(NUMBER),.START,SEARCH,"B",.SCR,"","RETURN","ERR")
+10 QUIT
+11 ;
LSTCSTA1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow cancellation. MBAA RPC: MBAA CANCEL APPOINTMENT
+1 NEW FILE,FIELDS,RET,SCR
+2 SET FILE="409.63"
SET FIELDS="@;.01"
+3 if $DATA(START)=0
SET START=""
if $DATA(SEARCH)=0
SET SEARCH=""
+4 SET START(1)=1
+5 SET START(2)=0
+6 DO LIST^DIC(FILE,"",FIELDS,"",$GET(NUMBER),.START,SEARCH,"ACAN",.SCR,"","RETURN","ERR")
+7 QUIT
+8 ;
LSTCIST1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow check in. MBAA RPC: MBAA APPOINTMENT MAKE
+1 NEW FILE,FIELDS,RET,SCR
+2 SET FILE="409.63"
SET FIELDS="@;.01"
+3 if $DATA(START)=0
SET START=""
if $DATA(SEARCH)=0
SET SEARCH=""
+4 SET START(1)=1
+5 SET START(2)=0
+6 DO LIST^DIC(FILE,"",FIELDS,"",$GET(NUMBER),.START,SEARCH,"ACI",.SCR,"","RETURN","ERR")
+7 QUIT
+8 ;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
+9 ;LSTCOST1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow check in.
+10 ; N FILE,FIELDS,RET,SCR
+11 ; S FILE="409.63",FIELDS="@;.01"
+12 ; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
+13 ; S START(1)=1
+14 ; S START(2)=0
+15 ; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"ACO",.SCR,"","RETURN","ERR")
+16 ; Q
+17 ;
+18 ;LSTNSTA1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow no-show.
+19 ;N FILE,FIELDS,RET,SCR
+20 ;S FILE="409.63",FIELDS="@;.01"
+21 ;S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
+22 ;S START(1)=1
+23 ;S START(2)=0
+24 ;D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"ANS",,"","RETURN","ERR")
+25 ;Q
+26 ;
GETAPT0(DFN,SD) ; Get appointment 0 node MBAA RPC: MBAA CANCEL APPOINTMENT
+1 ;ICR#: 6053 DPT
QUIT $GET(^DPT(DFN,"S",SD,0))
+2 ;
GETPAPT(RETURN,DFN,SD) ; Get patient appointment Called by RPC MBAA APPOINTMENT MAKE
+1 ; MBAA*1*7;WCJ;Seems like it would more efficient to string them all together and make one GETS^DIQ call, just saying
+2 NEW IND
+3 FOR IND=0:0
SET IND=$ORDER(RETURN(IND))
if IND=""
QUIT
Begin DoDot:1
+4 SET RETURN(IND)=$$GET1^DIQ(2.98,SD_","_DFN_",",IND,"I")
End DoDot:1
+5 SET RETURN=1
+6 QUIT
+7 ;
