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

MBAAMDA1.m

Go to the documentation of this file. 
  1. MBAAMDA1 ;OIT-PD/CBR - 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.  ;  10038 HOLIDAY FILE
  1.  ;  6044 SC(
  1.  ;  10103 XLFDT
  1.  ;
  1. GETCLN(RETURN,CLN,INT,EXT,REZ) ; Get clinic detail Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT, MBAA PATIENT PENDING APPT
  1.  N FILE,SFILES,FLDS
  1.  S FILE=44
  1.  S FLDS("*")=""
  1.  S SFILES("2501")="",SFILES("2501","N")="PRIVILEGED USER",SFILES("2501","F")="44.04"
  1.  S SFILES("1910")="",SFILES("1910","N")="SI",SFILES("1910","F")="44.03"
  1.  D GETREC^MBAAMDAL(.RETURN,CLN,FILE,.FLDS,.SFILES,$G(INT),$G(EXT),$G(REZ))
  1.  Q
  1.  ;
  1. GETCLNX(RETURN,SC) ; Get clinic detailx Called by RPC MBAA APPOINTMENT MAKE
  1.  N IND
  1.  F IND=0:0 S IND=$O(RETURN(IND)) Q:IND=""  D
  1.  . S RETURN(IND)=$$GET1^DIQ(44,SC_",",IND,"I")
  1.  S RETURN=1
  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.  ;LSTCLNS(RETURN,SEARCH,START,NUMBER) ; Return clinics filtered by name.
  1.  ; N FILE,FIELDS,RET,SCR
  1.  ; S FILE="44",FIELDS="@;.01"
  1.  ; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
  1.  ; S SCR="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))"
  1.  ; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"B",.SCR,"","RETURN")
  1.  ; Q
  1.  ; ;
  1. GETCSC(FLDS,CSC) ; Get Clinic Stop Code MBAA RPC: MBAA APPOINTMENT MAKE
  1.  N FLD,C
  1.  D GETS^DIQ(40.7,CSC,"*","I","C")
  1.  S FLD=""
  1.  F  S FLD=$O(C(40.7,""_CSC_",",FLD)) Q:FLD=""  D
  1.  . S FLDS(FLD)=C(40.7,""_CSC_",",FLD,"I")
  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.  ;CLNURGHT(CLN,USR,DATA) ; Return user right
  1.  ; S DATA=$G(^SC(CLN,"SDPRIV",USR,0))
  1.  ; Q
  1.  ;
  1.  ;LSTTMPL(RETURN,CLN) ; List defined day template
  1.  ; N FILE,SFILES,FLDS
  1.  ; S FILE=44
  1.  ; S SFILES("1922")="",SFILES("1922","N")="SUNDAY TEMPLATE",SFILES("1922","F")="44.06"
  1.  ; S SFILES("1923")="",SFILES("1923","N")="MONDAY TEMPLATE",SFILES("1923","F")="44.07"
  1.  ; S SFILES("1924")="",SFILES("1924","N")="TUESDAY TEMPLATE",SFILES("1924","F")="44.08"
  1.  ; S SFILES("1925")="",SFILES("1925","N")="WEDNESDAY TEMPLATE",SFILES("1925","F")="44.09"
  1.  ; S SFILES("1926")="",SFILES("1926","N")="THURSDAY TEMPLATE",SFILES("1926","F")="44.08"
  1.  ; S SFILES("1927")="",SFILES("1927","N")="FRIDAY TEMPLATE",SFILES("1927","F")="44.09"
  1.  ; S SFILES("1928")="",SFILES("1928","N")="SATURDAY TEMPLATE",SFILES("1928","F")="44.0001"
  1.  ; D GETREC^MBAAMDAL(.RETURN,CLN,FILE,.FLDS,.SFILES)
  1.  ; Q
  1.  ;
  1.  ;NXTAV(CLN,SD) ; Get next available day.
  1.  ; Q $O(^SC(CLN,"ST",SD))
  1.  ; ;
  1. GETHOL(RETURN,SDATE) ; Get holiday. Called by RPC MBAA APPOINTMENT MAKE
  1.  S RETURN=0
  1.  ;S:$D(^HOLIDAY(SDATE)) RETURN(0)=$G(^HOLIDAY(SDATE,0))
  1.  N X,X1
  1.  S X=$$GET1^DIQ(40.5,SDATE,.01,"I")  ;ICR#: 10038 HOLIDAY FILE
  1.  S X1=$$GET1^DIQ(40.5,SDATE,2,"I")  ;ICR#: 10038 HOLIDAY FILE
  1.  I $G(X)'="" S RETURN(0)=X_"^"_X1
  1.  K X,X1
  1.  S RETURN=1
  1.  Q
  1.  ;
  1.  ;GETPATT(RETURN,SC,SD) ; Get date pattern Called by RPC MBAA APPOINTMENT MAKE
  1. GETPATT(RETURN,SC,SD) ; Get date pattern Called by RPC MBAA APPOINTMENT MAKE
  1.  S RETURN=0
  1.  ;T13 change to use FM reads
  1.  N X S IENS=$P(SD,".")_","_SC_",",X=$$GET1^DIQ(44.005,IENS,1),RETURN(0)=$G(X)
  1.  ;S:$D(^SC(SC,"ST",$P(SD,"."),1)) RETURN(0)=^SC(SC,"ST",$P(SD,"."),1)  ;ICR#: 6044 SC(
  1.  ;N X S IENS=$P(SD,".")_","_SC_",",X=$$GET1^DIQ(44.005,IENS,"CAN"),RETURN(0)=$G(X)
  1.  ;T13 the line below is removed as this node is not defined in the DD.
  1.  ;S:$D(^SC(SC,"ST",$P(SD,"."),"CAN")) RETURN(1)=^SC(SC,"ST",$P(SD,"."),"CAN")  ;ICR#: 6044 SC(
  1.  S RETURN=1
  1.  Q
  1.  ;
  1. GETSCAP(RETURN,SC,DFN,SD) ; Get clinic appointment Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT, MBAA PATIENT PENDING APPT
  1.  N ZL,CO
  1.  I $D(^SC(SC,"S",SD))  D  ;ICR#: 6044 SC(
  1.  . S ZL=0
  1.  . F  S ZL=$O(^SC(SC,"S",SD,1,ZL)) Q:'ZL  D  ;ICR#: 6044 SC(
  1.  . . I '$D(^SC(SC,"S",SD,1,ZL,0)) Q  ;ICR#: 6044 SC(
  1.  . . S IENS=$G(ZL)_","_$G(SD)_","_$G(SC)_",",FLDS=".01;1;2;3;4;7;8;10;310;30;9;688"
  1.  . . N LEN,XRAY,OTHER,WARD,CLERK,DTMADE,XRAYRST,APTCAN,ELIG,OB,ARRAY,ERR,CON1
  1.  . . N ARRAY,ERR D GETS^DIQ(44.003,IENS,FLDS,"IE","ARRAY","ERR")
  1.  . . I $G(ARRAY(44.003,IENS,.01,"I"))'=DFN Q
  1.  . . S LEN=$G(ARRAY(44.003,IENS,1,"I")),XRAY=$G(ARRAY(44.003,IENS,2,"I")),OTHER=$G(ARRAY(44.003,IENS,3,"I"))
  1.  . . S WARD=$G(ARRAY(44.003,IENS,4,"I")),CLERK=$G(ARRAY(44.003,IENS,7,"I")),DTMADE=$G(ARRAY(44.003,IENS,8,"I")),OB=$G(ARRAY(44.003,IENS,9,"I"))
  1.  . . S XRAYRST=$G(ARRAY(44.003,IENS,10,"I")),APTCAN=$G(ARRAY(44.003,IENS,310,"I")),ELIG=$G(ARRAY(44.003,IENS,30,"I")),CON1=$G(ARRAY(44.003,IENS,688,"I"))
  1.  . . ;N CON1 S CON1=$$GET1^DIQ(44,IENS,688)
  1.  . . S RETURN(0)=$G(DFN)_U_$G(LEN)_U_$G(XRAY)_U_$G(OTHER)_U_$G(WARD)_U_$G(CLERK)_U_$G(DTMADE)_U_$G(XRAYRST)_U_$G(APTCAN)_U_$G(ELIG)_U_$G(CON1)
  1.  . . S:$G(OB)'="" RETURN("OB")=$G(OB)
  1.  . . S RETURN=ZL
  1.  . Q
  1.  Q
  1.  ;
  1. GETCAPT(RETURN,SC,SD,IFN,FLAG) ; Get clinic appointment by IFN Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
  1.  N CAPT
  1.  S DIQ="CAPT(",DIC="^SC(SC,""S"",SD,1,",DIQ(0)=$G(FLAG)  ;ICR#: 6044 SC(
  1.  S DA=IFN,DR=".01;1;3;7;8;9;30;309;302;303;304;306;688"
  1.  D EN^DIQ1
  1.  M RETURN=CAPT(44.003,IFN)
  1.  S RETURN(222)=SC
  1.  S RETURN(333)=IFN
  1.  Q
  1.  ;
  1. LOCKST(SC,SD) ; Lock availability node Called by RPC MBAA APPOINTMENT MAKE
  1.  L +^SC(SC,"ST",$P(SD,"."),1):5 Q:'$T 0  ;ICR#: 6044 SC(
  1.  Q 1
  1.  ;
  1. UNLCKST(SC,SD) ; Lock availability node  Called by RPC MBAA APPOINTMENT MAKE
  1.  L -^SC(SC,"ST",$P(SD,"."),1)  ;ICR#: 6044 SC(
  1.  Q
  1.  ;
  1. LOCKS(SC,SD) ; Lock clinic date node Called by RPC MBAA APPOINTMENT MAKE
  1.  L +^SC(SC,"S",$P(SD,"."),1):5 Q:'$T 0  ;ICR#: 6044 SC(
  1.  Q 1
  1.  ;
  1. UNLCKS(SC,SD) ; Unlock clinic date node Called by RPC MBAA APPOINTMENT MAKE
  1.  L -^SC(SC,"S",$P(SD,"."),1)  ;ICR#: 6044 SC(
  1.  Q
  1.  ;
  1. SETST(SC,SD,S) ; Set availability Called by RPC MBAA APPOINTMENT MAKE
  1.  ;S ^SC(SC,"ST",$P(SD,".",1),1)=S  ;ICR#: 6044 SC(
  1.  ;T13 CHANGE
  1.  N ERR,FDA,IENS
  1.  S IENS=$P(SD,".")_","_SC_","
  1.  ;S IENS(2)=$P(SD,".")
  1.  ;S FDA(44.005,IENS,.01)=$P(SD,".")
  1.  S FDA(44.005,IENS,1)=$G(S)
  1.  D FILE^DIE("","FDA","ERR")
  1.  Q
  1.  ;
  1.  ;MAKE(SC,SD,DFN,LEN,SM,USR,OTHR,RQXRAY) ; Make clinic appointment Called by RPC MBAA APPOINTMENT MAKE
  1. MAKE(SC,SD,DFN,LEN,SM,USR,OTHR,RQXRAY)  ; Make clinic appointment Called by the RPC MBAA APPOINTMENT MAKE
  1.  N ERR,FDA,IENS
  1.  S IENS="?+2,"_SC_","   ;WCJ;MBAA*1*7 added ? because it might already be there.  Otherwise false error is returned on occassion.
  1.  S IENS(2)=+SD
  1.  S FDA(44.001,IENS,.01)=+SD
  1.  D UPDATE^DIE("","FDA","IENS","ERR")
  1.  S SD=$G(IENS(2))
  1.  K FDA,IENS
  1.  S IENS="+1,"_+SD_","_SC_","
  1.  S FDA(44.003,IENS,.01)=DFN
  1.  S FDA(44.003,IENS,1)=LEN
  1.  S FDA(44.003,IENS,3)=$G(OTHR)
  1.  S FDA(44.003,IENS,7)=USR
  1.  S FDA(44.003,IENS,8)=$P($$NOW^XLFDT,".")  ;ICR#: 10103 XLFDT
  1.  S:$G(SM) FDA(44.003,IENS,9)="O"
  1.  ;T13 change
  1.  ;I $D(RQXRAY),RQXRAY>0 S ^SC("ARAD",SC,SD,DFN)=""  ;ICR#: 6044 SC(
  1.  I $D(RQXRAY),RQXRAY>0 S FDA(44.003,IENS,10)="Y"  ;ICR#: 6044 SC(
  1.  D UPDATE^DIE("","FDA","IENS","ERR")
  1.  Q
  1.  ;
  1. CANCEL(SC,SD,DFN,CIFN) ; Kill clinic appointment Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
  1.  ;S SDNODE=^SC(SC,"S",SD,1,CIFN,0)
  1.  N HSI,SB,SDDIF,SI,SL,SS,ST,STARTDAY,STR
  1.  S SC1=SC
  1.  S ^SC("ARAD",SC,SD,DFN)="N"  ;ICR#: 6044 SC(
  1.  ;S TLNK=$P($G(^SC(SC,"S",SD,1,CIFN,"CONS")),U)  ;ICR#: 6044 SC(
  1.  K ^SC(SC,"S",SD,1,CIFN)  ;ICR#: 6044 SC(
  1.  K:$O(^SC(SC,"S",SD,0))'>0 ^SC(SC,"S",SD,0)  ;ICR#: 6044 SC(
  1.  ;T13 CHANGE
  1.  ;K:TLNK'="" ^SC("AWAS1",TLNK),TLNK  ;ICR#: 6044 SC(
  1.  Q:'$D(^SC(SC,"ST",SD\1,1))  ;ICR#: 6044 SC(
  1.  ;T13 Change
  1.  N XL1,IENS
  1.  S IENS=SC_"," D GETS^DIQ(44,IENS,"1914;1917","I","XL1") S SL=$G(XL1(44,IENS,1917,"I")),X=$G(XL1(44,IENS,1914,"I"))
  1.  ;MBAA*1*5 - correct cancellation - calculation of X value
  1.  S SL=$$GET1^DIQ(44,SC,1917,"I"),STARTDAY=$S($L(X):X,1:8),SB=STARTDAY-1/100,X=SL,HSI=$S(X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y  ;ICR#: 6044 SC(
  1.  ;S SL=$$GET1^DIQ(44,SC,1917,"I"),STARTDAY=$S($L(X):X,1:8),SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y  ;ICR#: 6044 SC(
  1.  ;S SL=^SC(SC,"SL"),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y  ;ICR#: 6044 SC(
  1.  N IENS
  1.  S:$G(CAPT("LENGTH")) SL=CAPT("LENGTH") ;MBAA*1*5 - include length of appointment in calculation
  1.  S IENS=$P(SD,".")_","_SC_",",S=$$GET1^DIQ(44.005,IENS,1),Y=SD#1-SB*100,ST=Y#1*SI\.6+(Y\1*SI),SS=SL*HSI/60
  1.  ;S S=^SC(SC,"ST",SD\1,1),Y=SD#1-SB*100,ST=Y#1*SI\.6+(Y\1*SI),SS=SL*HSI/60  ;ICR#: 6044 SC(
  1.  I Y'<1 F I=ST+ST:SDDIF S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y=""  S S=$E(S,1,I)_Y_$E(S,I+2,999),SS=SS-1 Q:SS'>0
  1.  ;Code below changed to correct the naked global reference
  1.  ;S ^(1)=S
  1.  ;S ^SC(SC,"ST",SD\1,1)=S  ;ICR#: 6044 SC(
  1.  ;T13 CHANGE
  1.  S SC=SC1 K SC1
  1.  D SETST(SC,SD,S)
  1.  Q
  1.  ;
  1. COVERB(SC,SD,IFN) ; Kill first overbook appointment Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
  1.  I $D(^SC(SC,"S",SD,1,IFN,"OB")) Q 0  ;ICR#: 6044 SC(
  1.  N X,OIFN
  1.  S X=IFN,OIFN=0
  1.  F  S X=$O(^SC(SC,"S",SD,1,X)) Q:X=""!(OIFN>0)  D  ;ICR#: 6044 SC(
  1.  . I $D(^SC(SC,"S",SD,1,X,"OB")) K ^SC(SC,"S",SD,1,X,"OB") S OIFN=X  ;ICR#: 6044 SC(
  1.  Q OIFN
  1.  ;
  1. GETFSTA(SC) ; Get first available day. Called by RPC MBAA APPOINTMENT MAKE
  1.  N I
  1.  S I=0
  1.  Q $O(^SC(SC,"T",I))  ;ICR#: 6044 SC(
  1.  ;
  1. GETDAYA(RETURN,SC,SD) ; Get all day appointments Called by RPC MBAA APPOINTMENT MAKE
  1.  N IND,I,D
  1.  S I=$P(SD,".",1)
  1.  F D=I-.01:0 S D=$O(^SC(SC,"S",D)) Q:$P(D,".",1)-I  D  ;ICR#: 6044 SC(
  1.  . S %=0
  1.  . F  S %=$O(^SC(SC,"S",D,1,%)) Q:%'>0  D  ;ICR#: 6044 SC(
  1.  . . Q:'$D(^SC(SC,"S",D,1,%,0))  ;ICR#: 6044 SC(
  1.  . . ; next two lines changed to correct the naked global reference
  1.  . . ;S RETURN(%,"STATUS")=$P(^(0),U,9)
  1.  . . ;S RETURN(%,"OB")=$D(^("OB"))
  1.  . . ;T13 Change
  1.  . . S DIQ="CAPT(",DIC="^SC(SC,""S"",D,1,",DA=%,DR="310;9" D EN^DIQ1
  1.  . . S %=DA
  1.  . . S RETURN(%,"STATUS")=$G(CAPT(44.003,%,310))
  1.  . . S RETURN(%,"OB")=$G(CAPT(44.003,%,9))
  1.  . . K DIQ,DA,DR,DIC,CAPT
  1.  . . I $G(I)="" S I=$P(SD,".",1)
  1.  . . ;S RETURN(%,"STATUS")=$P(^SC(SC,"S",D,1,%,0),U,9)
  1.  . . ;S RETURN(%,"OB")=$D(^SC(SC,"S",D,1,%,"OB"))
  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.  ;LSTCAPTS(RETURN,SC,SDBEG,SDEND) ; 
  1.  ; N SDT,SDDA,CNT,APT,SDATA,CNSTLNK
  1.  ; S CNT=0 S:'$D(SDBEG) SDBEG=1 S:'$D(SDEND) SDEND=99999999
  1.  ; F SDT=SDBEG:0 S SDT=$O(^SC(SC,"S",SDT)) Q:'SDT!($P(SDT,".",1)>SDEND)  D
  1.  ; . F SDDA=0:0 S SDDA=$O(^SC(SC,"S",SDT,1,SDDA)) Q:'SDDA  D
  1.  ; . . S CNSTLNK=$P($G(^SC(SC,"S",SDT,1,SDDA,"CONS")),U)
  1.  ; . . Q:'$D(^SC(SC,"S",SDT,1,SDDA,0))
  1.  ; . . ; next line changed to correct the naked global reference
  1.  ; . . ;S APT=^(0)
  1.  ; . . S APT=$G(^SC(SC,"S",SDT,1,SDDA,0))
  1.  ; . . S CNT=CNT+1
  1.  ; . . S SDATA=^DPT(+APT,"S",SDT,0)
  1.  ; . . S RETURN(CNT,"CONS")=$G(CNSTLNK)
  1.  ; . . S RETURN(CNT,"SD")=SDT
  1.  ; . . S RETURN(CNT,"SC")=+SDATA
  1.  ; . . S RETURN(CNT,"DFN")=+APT
  1.  ; . . S RETURN(CNT,"SDDA")=SDDA
  1.  ; . . S RETURN(CNT,"SDATA")=SDATA
  1.  ; . . S RETURN(CNT,"CDATA")=APT
  1.  ; Q
  1.  ; ;
  1.  ;LSTPAPTS(RETURN,DFN,SDBEG,SDEND) ; Get patient appointments
  1.  ; N SDT,CNT,SDDA,SC,CN,CNPAT
  1.  ; S CNT=0 S:'$D(SDBEG) SDBEG=DT S:'$D(SDEND) SDEND=99999999
  1.  ; F SDT=SDBEG:0 S SDT=$O(^DPT(DFN,"S",SDT)) Q:'SDT!($P(SDT,".",1)>SDEND)  D
  1.  ; . Q:'$D(^(SDT,0))
  1.  ; . S CNT=CNT+1
  1.  ; . S SDATA=^DPT(+DFN,"S",SDT,0)
  1.  ; . S SC=+SDATA
  1.  ; . S RETURN(CNT,"CONS")=$G(CNSTLNK)
  1.  ; . S RETURN(CNT,"SD")=SDT
  1.  ; . S RETURN(CNT,"SC")=SC
  1.  ; . S RETURN(CNT,"DFN")=DFN
  1.  ; . S SDDA="",CN=0
  1.  ; . F  S CN=$O(^SC(SC,"S",SDT,1,CN)) Q:'+CN!(SDDA>0)  D
  1.  ; . . S CNPAT=$P($G(^SC(SC,"S",SDT,1,CN,0)),U)
  1.  ; . . Q:CNPAT'=DFN
  1.  ; . . S SDDA=CN
  1.  ; . S RETURN(CNT,"SDDA")=SDDA
  1.  ; . S RETURN(CNT,"SDATA")=SDATA
  1.  ; . S:SDDA>0 RETURN(CNT,"CDATA")=$G(^SC(SC,"S",SDT,1,SDDA,0))
  1.  ; Q
  1.  ;
  1. GETDST(SC,SD) ; Get day slot  Called by RPC MBAA APPOINTMENT MAKE
  1.  ;T13 change to use a FM call to get the data from the file
  1.  N X S IENS=$P(SD,".")_","_SC_",",X=$$GET1^DIQ(44.005,IENS,1)
  1.  Q X    ;ICR#: 6044 SC(
  1.  ;Q $G(^SC(SC,"ST",SD,1))  ;ICR#: 6044 SC(
  1.  ;
  1. GETDPATT(RETURN,SC,SD,DAY) ; Called by RPC MBAA APPOINTMENT MAKE
  1.  S RETURN("IEN")=$O(^SC(SC,"T"_DAY,SD))  ;ICR#: 6044 SC(
  1.  S:RETURN("IEN")'="" RETURN("PAT")=$G(^SC(SC,"T"_DAY,RETURN("IEN"),1))  ;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.  ;UPDPATT(DATA,SC,SD) ; Update day pattern
  1.  ; N IENS,I
  1.  ; S IENS=SD_","_SC_","
  1.  ; N FDA
  1.  ; F I=0:0 S I=$O(DATA(I)) Q:I=""  D
  1.  ; . S FDA(44.005,IENS,I)=DATA(I)
  1.  ; N ERR
  1.  ; D UPDATE^DIE("","FDA",,"ERR")
  1.  ; Q
  1.  ;
  1. ADDPATT(DATA,SC,SD) ; Add day pattern Called by RPC MBAA APPOINTMENT MAKE
  1.  N IENS,I,FDA,ERR
  1.  S IENS="+1,"_SC_","
  1.  S IENS(1)=SD
  1.  F I=0:0 S I=$O(DATA(I)) Q:I=""  D
  1.  . S FDA(44.005,IENS,I)=DATA(I)
  1.  D UPDATE^DIE("","FDA","IENS","ERR")
  1.  Q
  1.  ;
  1. LSTAENC(RETURN,SEARCH,START,NUMBER) ; Returns active encounters. MBAA RPC: MBAA APPOINTMENT MAKE
  1.  N FILE,FIELDS,RET,SCR
  1.  S FILE="409.68",FIELDS="@;.01I;.04I;.06"
  1.  S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
  1.  S SCR="I $P(^(0),""^"",2)="_SEARCH_"&($D(^SCE(""ADFN"","_SEARCH_",$P(^(0),""^"",1))))"
  1.  K SEARCH
  1.  D LIST^DIC(FILE,"",.FIELDS,"",$G(NUMBER),.START,.SEARCH,"B",.SCR,"","RETURN","ERR")
  1.  Q