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

MBAAMDA2.m

Go to the documentation of this file. 
  1. MBAAMDA2 ;OIT-PD/VSL - APPOINTMENT API ;02/10/2016
  1.  ;;1.0;Scheduling Calendar View;**1,5,7**;Feb 13, 2015;Build 16
  1.  ;
  1.  ;Associated ICRs
  1.  ;  ICR#
  1.  ;  6053 DPT
  1.  ;  6044 SC(
  1.  ;
  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.  ;FRSTAVBL(RETURN,SC) ; Get first available date
  1.  ; S RETURN=$O(^SC(+SC,"T",0))
  1.  ; S RETURN=$O(^(0))
  1.  ; Q
  1.  ; ;
  1. SLOTS(RETURN,SC,SD) ; Get available slots MBAA RPC: MBAA GET CLINIC AVAILABILITY
  1.  ; RETURN - RETURN array passed in by reference
  1.  ; SC - scheduling clinic IEN of File #44
  1.  ; SD - starting date for slots - use DT if not passed in
  1.  ;
  1.  ;WCJ;MBAA*1*7; Start with either a date passed in or today.
  1.  I '$G(SD) S SD=DT
  1.  S SD=$$FMADD^XLFDT($P(SD,"."),-1,0,0,0)
  1.  ;
  1.  F  S SD=$O(^SC(SC,"ST",SD)) Q:SD'>0  D    ;ICR#: 6044 SC(
  1.  .N IENS,ARRAY,ERR
  1.  .S IENS=$G(SD)_","_SC_","
  1.  .D GETS^DIQ(44.005,IENS,".01;1","I","ARRAY","ERR")
  1.  .S RETURN(SD,0)=$G(ARRAY(44.005,IENS,.01,"I"))
  1.  .S RETURN(SD,1)=$G(ARRAY(44.005,IENS,1,"I"))
  1.  .I $E(RETURN(SD,1),6,11)="      " S $E(RETURN(SD,1),6,11)="  " Q  ;MBAA*1*5 - 10 MINS SLOTS
  1.  .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
  1.  ;
  1.  ;K SD
  1.  ;M RETURN=^SC(+SC,"ST")  ;ICR#: 6044 SC(
  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
  1.  ;SCEXST(RETURN,CSC) ; Returns Outpatient Classification Stop Code Exception status
  1.  ; N FILE,STOPN,IENACT,FLDS,FS
  1.  ; S STOPN=$$GET1^DIQ(40.7,+CSC_",",1)
  1.  ; S IENACT=""
  1.  ; S IENACT=$O(^SD(409.45,"B",STOPN,IENACT))
  1.  ; S FILE="409.45"
  1.  ; S FLDS("*")=""
  1.  ; S FS("75")="",FS("75","F")="409.4575",FS("75","N")="EFFECTIVE DATE"
  1.  ; S RETURN=0
  1.  ; I $D(IENACT) D
  1.  ; . D GETREC^MBAAMDAL(.RETURN,IENACT,FILE,.FLDS,.FS,1,1,1) S RETURN=1
  1.  ; Q
  1.  ; ;
  1. LSTAPPT(RETURN,SEARCH,START,NUMBER) ; Lists appointment types MBAA RPC: MBAA APPOINTMENT LIST BY NAME
  1.  N FILE,FIELDS,RET
  1.  S FILE="409.1",FIELDS="@;.01"
  1.  S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
  1.  D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"B","","","RETURN")
  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
  1.  ;GETAPPT(RETURN,TYPE,INT,EXT,REZ) ; Get Appointment Type
  1.  ; N FILE,FLDS,SF
  1.  ; S FILE=409.1,FLDS("*")=""
  1.  ; D GETREC^MBAAMDAL(.RETURN,TYPE,FILE,.FLDS,.SF,$G(INT),$G(EXT),$G(REZ))
  1.  ; Q
  1.  ;
  1.  ;GETELIG(RETURN,ELIG,INT,EXT,REZ) ; Get eligibility code
  1.  ;N FILE,FLDS
  1.  ;S FILE=8,FLDS("*")=""
  1.  ;D GETREC^MBAAMDAL(.RETURN,ELIG,FILE,.FLDS,,$G(INT),$G(EXT),$G(REZ))
  1.  ;Q
  1.  ; ;
  1.  ;HASPEND(RETURN,PAT,DT) ; Return 1 if patient has pending appointment
  1.  ; S RETURN=0
  1.  ; I '$D(^DPT(+$G(PAT),0)) D ERRX^MBAAAPIE(.RETURN,"PATNFND") Q RETURN
  1.  ; S:$O(^DPT(PAT,"S",DT))>DT RETURN=1
  1.  ; Q RETURN
  1.  ; ;
  1.  ;GETPEND(RETURN,PAT,DT) ; Get pending appointments
  1.  ; N Y,AP
  1.  ; F Y=DT:0 S Y=$O(^DPT(PAT,"S",Y)) Q:Y'>0  D
  1.  ; . S AP=^(Y,0)
  1.  ; . I "I"[$P(AP,U,2) D
  1.  ; . . S RETURN(Y,.01)=$P(AP,U,1)
  1.  ; . . S RETURN(Y,13)=$P(AP,U,11)
  1.  ; . . S RETURN(Y,9.5)=$P(AP,U,16)
  1.  ; . . S RETURN(Y,2)=$P(AP,U,3)
  1.  ; . . S RETURN(Y,3)=$P(AP,U,4)
  1.  ; . . S RETURN(Y,4)=$P(AP,U,5)
  1.  ; Q
  1.  ; ;
  1. APTYNAME(TYPE) ; Get appointment type name MBAA RPC: MBAA PATIENT PENDING APPT
  1.  Q $$GET1^DIQ(409.1,TYPE_",",.01)
  1.  ;
  1. GETAPTS(RETURN,DFN,SD) ; Get patient appointments Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
  1.  ;INPUT
  1.  ; RETURN - by reference for results being RETURNed
  1.  ; DFN - IEN to PATIENT (#2) file
  1.  ; SD - FileMan Date time if you want information on a specific appointment
  1.  ;
  1.  N FILE,SFILES,TMPDT
  1.  S FILE=2
  1.  S SFILES("1900")="",SFILES("1900","N")="APT",SFILES("1900","F")="2.98"
  1.  D GETREC^MBAAMDAL(.RETURN,DFN,FILE,,.SFILES,1,1,1,$G(SD))
  1.  Q
  1.  ;
  1.  ; Placed Quit above
  1.  ; it would only get here if called from future functionality SCHED^MBAAAPI1
  1.  ; replaced code altering DT to use TMPDT - otherwise a violation of SAC
  1.  S TMPDT=$S(SD(0)=1:$P(SD,"."),SD(0)=0:$O(APTS("APT","")))
  1.  F  S TMPDT=$O(APTS("APT",TMPDT)) Q:TMPDT=""  D
  1.  . M RETURN("APT",TMPDT)=APTS("APT",TMPDT)
  1.  Q
  1.  ;
  1. GETDAPTS(RETURN,DFN,SD) ; Get all appointments in the day Called by RPC MBAA APPOINTMENT MAKE
  1.  N NOD
  1.  S RETURN=0
  1.  S IND=$P(SD,".")
  1.  F  S IND=$O(^DPT(DFN,"S",IND)) Q:IND=""!($P(IND,".")>$P(SD,"."))  D  ;ICR#: 6053 DPT
  1.  . ;T13 Change to use FM to get these fields
  1.  . N ARRAY S IENS=$G(SD)_","_$G(DFN)_"," D GETS^DIQ(2.98,IENS,".01;3","I","ARRAY")
  1.  . S RETURN(IND,1)=$G(ARRAY(2.98,IENS,.01,"I"))
  1.  . S RETURN(IND,2)=$G(ARRAY(2.98,IENS,3,"I"))
  1.  S RETURN=1
  1.  Q
  1.  ;
  1. LSTCRSNS(RETURN,SEARCH,START,NUMBER) ; MBAA RPC: MBAA LIST CANCELLATION REASONS
  1.  N FILE,FIELDS,RET,SCR,TYP
  1.  S FILE="409.2",FIELDS="@;.01"
  1.  S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
  1.  ;T16 Change to return only cancel reasons that a patient can select
  1.  ;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))"
  1.  I $D(RETURN("TYPE")) S TYP=RETURN("TYPE")
  1.  S SCR="I ""BP""[$P(^(0),U,2)"
  1.  K RETURN
  1.  D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"B",.SCR,"","RETURN","ERR")
  1.  Q
  1.  ;
  1. LSTCSTA1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow cancellation. MBAA RPC: MBAA CANCEL APPOINTMENT
  1.  N FILE,FIELDS,RET,SCR
  1.  S FILE="409.63",FIELDS="@;.01"
  1.  S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
  1.  S START(1)=1
  1.  S START(2)=0
  1.  D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"ACAN",.SCR,"","RETURN","ERR")
  1.  Q
  1.  ;
  1. LSTCIST1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow check in. MBAA RPC: MBAA APPOINTMENT MAKE
  1.  N FILE,FIELDS,RET,SCR
  1.  S FILE="409.63",FIELDS="@;.01"
  1.  S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
  1.  S START(1)=1
  1.  S START(2)=0
  1.  D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"ACI",.SCR,"","RETURN","ERR")
  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
  1.  ;LSTCOST1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow check in.
  1.  ; N FILE,FIELDS,RET,SCR
  1.  ; S FILE="409.63",FIELDS="@;.01"
  1.  ; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
  1.  ; S START(1)=1
  1.  ; S START(2)=0
  1.  ; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"ACO",.SCR,"","RETURN","ERR")
  1.  ; Q
  1.  ;
  1.  ;LSTNSTA1(RETURN,SEARCH,START,NUMBER) ; Returns the list of states that allow no-show. 
  1.  ;N FILE,FIELDS,RET,SCR
  1.  ;S FILE="409.63",FIELDS="@;.01"
  1.  ;S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
  1.  ;S START(1)=1
  1.  ;S START(2)=0
  1.  ;D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"ANS",,"","RETURN","ERR")
  1.  ;Q
  1.  ;
  1. GETAPT0(DFN,SD) ; Get appointment 0 node MBAA RPC: MBAA CANCEL APPOINTMENT
  1.  Q $G(^DPT(DFN,"S",SD,0))  ;ICR#: 6053 DPT
  1.  ;
  1. 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
  1.  N IND
  1.  F IND=0:0 S IND=$O(RETURN(IND)) Q:IND=""  D
  1.  . S RETURN(IND)=$$GET1^DIQ(2.98,SD_","_DFN_",",IND,"I")
  1.  S RETURN=1
  1.  Q
  1.  ;