MBAAMDA1 ;OIT-PD/CBR - APPOINTMENT API ;02/10/2016
;;1.0;Scheduling Calendar View;**1,5,7**;Feb 13, 2015;Build 16
;
;Associated ICRs
; ICR#
; 10038 HOLIDAY FILE
; 6044 SC(
; 10103 XLFDT
;
GETCLN(RETURN,CLN,INT,EXT,REZ) ; Get clinic detail Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT, MBAA PATIENT PENDING APPT
N FILE,SFILES,FLDS
S FILE=44
S FLDS("*")=""
S SFILES("2501")="",SFILES("2501","N")="PRIVILEGED USER",SFILES("2501","F")="44.04"
S SFILES("1910")="",SFILES("1910","N")="SI",SFILES("1910","F")="44.03"
D GETREC^MBAAMDAL(.RETURN,CLN,FILE,.FLDS,.SFILES,$G(INT),$G(EXT),$G(REZ))
Q
;
GETCLNX(RETURN,SC) ; Get clinic detailx Called by RPC MBAA APPOINTMENT MAKE
N IND
F IND=0:0 S IND=$O(RETURN(IND)) Q:IND="" D
. S RETURN(IND)=$$GET1^DIQ(44,SC_",",IND,"I")
S RETURN=1
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
;LSTCLNS(RETURN,SEARCH,START,NUMBER) ; Return clinics filtered by name.
; N FILE,FIELDS,RET,SCR
; S FILE="44",FIELDS="@;.01"
; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
; S SCR="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))"
; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"B",.SCR,"","RETURN")
; Q
; ;
GETCSC(FLDS,CSC) ; Get Clinic Stop Code MBAA RPC: MBAA APPOINTMENT MAKE
N FLD,C
D GETS^DIQ(40.7,CSC,"*","I","C")
S FLD=""
F S FLD=$O(C(40.7,""_CSC_",",FLD)) Q:FLD="" D
. S FLDS(FLD)=C(40.7,""_CSC_",",FLD,"I")
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
;CLNURGHT(CLN,USR,DATA) ; Return user right
; S DATA=$G(^SC(CLN,"SDPRIV",USR,0))
; Q
;
;LSTTMPL(RETURN,CLN) ; List defined day template
; N FILE,SFILES,FLDS
; S FILE=44
; S SFILES("1922")="",SFILES("1922","N")="SUNDAY TEMPLATE",SFILES("1922","F")="44.06"
; S SFILES("1923")="",SFILES("1923","N")="MONDAY TEMPLATE",SFILES("1923","F")="44.07"
; S SFILES("1924")="",SFILES("1924","N")="TUESDAY TEMPLATE",SFILES("1924","F")="44.08"
; S SFILES("1925")="",SFILES("1925","N")="WEDNESDAY TEMPLATE",SFILES("1925","F")="44.09"
; S SFILES("1926")="",SFILES("1926","N")="THURSDAY TEMPLATE",SFILES("1926","F")="44.08"
; S SFILES("1927")="",SFILES("1927","N")="FRIDAY TEMPLATE",SFILES("1927","F")="44.09"
; S SFILES("1928")="",SFILES("1928","N")="SATURDAY TEMPLATE",SFILES("1928","F")="44.0001"
; D GETREC^MBAAMDAL(.RETURN,CLN,FILE,.FLDS,.SFILES)
; Q
;
;NXTAV(CLN,SD) ; Get next available day.
; Q $O(^SC(CLN,"ST",SD))
; ;
GETHOL(RETURN,SDATE) ; Get holiday. Called by RPC MBAA APPOINTMENT MAKE
S RETURN=0
;S:$D(^HOLIDAY(SDATE)) RETURN(0)=$G(^HOLIDAY(SDATE,0))
N X,X1
S X=$$GET1^DIQ(40.5,SDATE,.01,"I") ;ICR#: 10038 HOLIDAY FILE
S X1=$$GET1^DIQ(40.5,SDATE,2,"I") ;ICR#: 10038 HOLIDAY FILE
I $G(X)'="" S RETURN(0)=X_"^"_X1
K X,X1
S RETURN=1
Q
;
;GETPATT(RETURN,SC,SD) ; Get date pattern Called by RPC MBAA APPOINTMENT MAKE
GETPATT(RETURN,SC,SD) ; Get date pattern Called by RPC MBAA APPOINTMENT MAKE
S RETURN=0
;T13 change to use FM reads
N X S IENS=$P(SD,".")_","_SC_",",X=$$GET1^DIQ(44.005,IENS,1),RETURN(0)=$G(X)
;S:$D(^SC(SC,"ST",$P(SD,"."),1)) RETURN(0)=^SC(SC,"ST",$P(SD,"."),1) ;ICR#: 6044 SC(
;N X S IENS=$P(SD,".")_","_SC_",",X=$$GET1^DIQ(44.005,IENS,"CAN"),RETURN(0)=$G(X)
;T13 the line below is removed as this node is not defined in the DD.
;S:$D(^SC(SC,"ST",$P(SD,"."),"CAN")) RETURN(1)=^SC(SC,"ST",$P(SD,"."),"CAN") ;ICR#: 6044 SC(
S RETURN=1
Q
;
GETSCAP(RETURN,SC,DFN,SD) ; Get clinic appointment Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT, MBAA PATIENT PENDING APPT
N ZL,CO
I $D(^SC(SC,"S",SD)) D ;ICR#: 6044 SC(
. S ZL=0
. F S ZL=$O(^SC(SC,"S",SD,1,ZL)) Q:'ZL D ;ICR#: 6044 SC(
. . I '$D(^SC(SC,"S",SD,1,ZL,0)) Q ;ICR#: 6044 SC(
. . S IENS=$G(ZL)_","_$G(SD)_","_$G(SC)_",",FLDS=".01;1;2;3;4;7;8;10;310;30;9;688"
. . N LEN,XRAY,OTHER,WARD,CLERK,DTMADE,XRAYRST,APTCAN,ELIG,OB,ARRAY,ERR,CON1
. . N ARRAY,ERR D GETS^DIQ(44.003,IENS,FLDS,"IE","ARRAY","ERR")
. . I $G(ARRAY(44.003,IENS,.01,"I"))'=DFN Q
. . 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"))
. . 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"))
. . 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"))
. . ;N CON1 S CON1=$$GET1^DIQ(44,IENS,688)
. . 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)
. . S:$G(OB)'="" RETURN("OB")=$G(OB)
. . S RETURN=ZL
. Q
Q
;
GETCAPT(RETURN,SC,SD,IFN,FLAG) ; Get clinic appointment by IFN Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
N CAPT
S DIQ="CAPT(",DIC="^SC(SC,""S"",SD,1,",DIQ(0)=$G(FLAG) ;ICR#: 6044 SC(
S DA=IFN,DR=".01;1;3;7;8;9;30;309;302;303;304;306;688"
D EN^DIQ1
M RETURN=CAPT(44.003,IFN)
S RETURN(222)=SC
S RETURN(333)=IFN
Q
;
LOCKST(SC,SD) ; Lock availability node Called by RPC MBAA APPOINTMENT MAKE
L +^SC(SC,"ST",$P(SD,"."),1):5 Q:'$T 0 ;ICR#: 6044 SC(
Q 1
;
UNLCKST(SC,SD) ; Lock availability node Called by RPC MBAA APPOINTMENT MAKE
L -^SC(SC,"ST",$P(SD,"."),1) ;ICR#: 6044 SC(
Q
;
LOCKS(SC,SD) ; Lock clinic date node Called by RPC MBAA APPOINTMENT MAKE
L +^SC(SC,"S",$P(SD,"."),1):5 Q:'$T 0 ;ICR#: 6044 SC(
Q 1
;
UNLCKS(SC,SD) ; Unlock clinic date node Called by RPC MBAA APPOINTMENT MAKE
L -^SC(SC,"S",$P(SD,"."),1) ;ICR#: 6044 SC(
Q
;
SETST(SC,SD,S) ; Set availability Called by RPC MBAA APPOINTMENT MAKE
;S ^SC(SC,"ST",$P(SD,".",1),1)=S ;ICR#: 6044 SC(
;T13 CHANGE
N ERR,FDA,IENS
S IENS=$P(SD,".")_","_SC_","
;S IENS(2)=$P(SD,".")
;S FDA(44.005,IENS,.01)=$P(SD,".")
S FDA(44.005,IENS,1)=$G(S)
D FILE^DIE("","FDA","ERR")
Q
;
;MAKE(SC,SD,DFN,LEN,SM,USR,OTHR,RQXRAY) ; Make clinic appointment Called by RPC MBAA APPOINTMENT MAKE
MAKE(SC,SD,DFN,LEN,SM,USR,OTHR,RQXRAY) ; Make clinic appointment Called by the RPC MBAA APPOINTMENT MAKE
N ERR,FDA,IENS
S IENS="?+2,"_SC_"," ;WCJ;MBAA*1*7 added ? because it might already be there. Otherwise false error is returned on occassion.
S IENS(2)=+SD
S FDA(44.001,IENS,.01)=+SD
D UPDATE^DIE("","FDA","IENS","ERR")
S SD=$G(IENS(2))
K FDA,IENS
S IENS="+1,"_+SD_","_SC_","
S FDA(44.003,IENS,.01)=DFN
S FDA(44.003,IENS,1)=LEN
S FDA(44.003,IENS,3)=$G(OTHR)
S FDA(44.003,IENS,7)=USR
S FDA(44.003,IENS,8)=$P($$NOW^XLFDT,".") ;ICR#: 10103 XLFDT
S:$G(SM) FDA(44.003,IENS,9)="O"
;T13 change
;I $D(RQXRAY),RQXRAY>0 S ^SC("ARAD",SC,SD,DFN)="" ;ICR#: 6044 SC(
I $D(RQXRAY),RQXRAY>0 S FDA(44.003,IENS,10)="Y" ;ICR#: 6044 SC(
D UPDATE^DIE("","FDA","IENS","ERR")
Q
;
CANCEL(SC,SD,DFN,CIFN) ; Kill clinic appointment Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
;S SDNODE=^SC(SC,"S",SD,1,CIFN,0)
N HSI,SB,SDDIF,SI,SL,SS,ST,STARTDAY,STR
S SC1=SC
S ^SC("ARAD",SC,SD,DFN)="N" ;ICR#: 6044 SC(
;S TLNK=$P($G(^SC(SC,"S",SD,1,CIFN,"CONS")),U) ;ICR#: 6044 SC(
K ^SC(SC,"S",SD,1,CIFN) ;ICR#: 6044 SC(
K:$O(^SC(SC,"S",SD,0))'>0 ^SC(SC,"S",SD,0) ;ICR#: 6044 SC(
;T13 CHANGE
;K:TLNK'="" ^SC("AWAS1",TLNK),TLNK ;ICR#: 6044 SC(
Q:'$D(^SC(SC,"ST",SD\1,1)) ;ICR#: 6044 SC(
;T13 Change
N XL1,IENS
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"))
;MBAA*1*5 - correct cancellation - calculation of X value
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(
;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(
;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(
N IENS
S:$G(CAPT("LENGTH")) SL=CAPT("LENGTH") ;MBAA*1*5 - include length of appointment in calculation
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
;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(
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
;Code below changed to correct the naked global reference
;S ^(1)=S
;S ^SC(SC,"ST",SD\1,1)=S ;ICR#: 6044 SC(
;T13 CHANGE
S SC=SC1 K SC1
D SETST(SC,SD,S)
Q
;
COVERB(SC,SD,IFN) ; Kill first overbook appointment Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
I $D(^SC(SC,"S",SD,1,IFN,"OB")) Q 0 ;ICR#: 6044 SC(
N X,OIFN
S X=IFN,OIFN=0
F S X=$O(^SC(SC,"S",SD,1,X)) Q:X=""!(OIFN>0) D ;ICR#: 6044 SC(
. I $D(^SC(SC,"S",SD,1,X,"OB")) K ^SC(SC,"S",SD,1,X,"OB") S OIFN=X ;ICR#: 6044 SC(
Q OIFN
;
GETFSTA(SC) ; Get first available day. Called by RPC MBAA APPOINTMENT MAKE
N I
S I=0
Q $O(^SC(SC,"T",I)) ;ICR#: 6044 SC(
;
GETDAYA(RETURN,SC,SD) ; Get all day appointments Called by RPC MBAA APPOINTMENT MAKE
N IND,I,D
S I=$P(SD,".",1)
F D=I-.01:0 S D=$O(^SC(SC,"S",D)) Q:$P(D,".",1)-I D ;ICR#: 6044 SC(
. S %=0
. F S %=$O(^SC(SC,"S",D,1,%)) Q:%'>0 D ;ICR#: 6044 SC(
. . Q:'$D(^SC(SC,"S",D,1,%,0)) ;ICR#: 6044 SC(
. . ; next two lines changed to correct the naked global reference
. . ;S RETURN(%,"STATUS")=$P(^(0),U,9)
. . ;S RETURN(%,"OB")=$D(^("OB"))
. . ;T13 Change
. . S DIQ="CAPT(",DIC="^SC(SC,""S"",D,1,",DA=%,DR="310;9" D EN^DIQ1
. . S %=DA
. . S RETURN(%,"STATUS")=$G(CAPT(44.003,%,310))
. . S RETURN(%,"OB")=$G(CAPT(44.003,%,9))
. . K DIQ,DA,DR,DIC,CAPT
. . I $G(I)="" S I=$P(SD,".",1)
. . ;S RETURN(%,"STATUS")=$P(^SC(SC,"S",D,1,%,0),U,9)
. . ;S RETURN(%,"OB")=$D(^SC(SC,"S",D,1,%,"OB"))
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
;LSTCAPTS(RETURN,SC,SDBEG,SDEND) ;
; N SDT,SDDA,CNT,APT,SDATA,CNSTLNK
; S CNT=0 S:'$D(SDBEG) SDBEG=1 S:'$D(SDEND) SDEND=99999999
; F SDT=SDBEG:0 S SDT=$O(^SC(SC,"S",SDT)) Q:'SDT!($P(SDT,".",1)>SDEND) D
; . F SDDA=0:0 S SDDA=$O(^SC(SC,"S",SDT,1,SDDA)) Q:'SDDA D
; . . S CNSTLNK=$P($G(^SC(SC,"S",SDT,1,SDDA,"CONS")),U)
; . . Q:'$D(^SC(SC,"S",SDT,1,SDDA,0))
; . . ; next line changed to correct the naked global reference
; . . ;S APT=^(0)
; . . S APT=$G(^SC(SC,"S",SDT,1,SDDA,0))
; . . S CNT=CNT+1
; . . S SDATA=^DPT(+APT,"S",SDT,0)
; . . S RETURN(CNT,"CONS")=$G(CNSTLNK)
; . . S RETURN(CNT,"SD")=SDT
; . . S RETURN(CNT,"SC")=+SDATA
; . . S RETURN(CNT,"DFN")=+APT
; . . S RETURN(CNT,"SDDA")=SDDA
; . . S RETURN(CNT,"SDATA")=SDATA
; . . S RETURN(CNT,"CDATA")=APT
; Q
; ;
;LSTPAPTS(RETURN,DFN,SDBEG,SDEND) ; Get patient appointments
; N SDT,CNT,SDDA,SC,CN,CNPAT
; S CNT=0 S:'$D(SDBEG) SDBEG=DT S:'$D(SDEND) SDEND=99999999
; F SDT=SDBEG:0 S SDT=$O(^DPT(DFN,"S",SDT)) Q:'SDT!($P(SDT,".",1)>SDEND) D
; . Q:'$D(^(SDT,0))
; . S CNT=CNT+1
; . S SDATA=^DPT(+DFN,"S",SDT,0)
; . S SC=+SDATA
; . S RETURN(CNT,"CONS")=$G(CNSTLNK)
; . S RETURN(CNT,"SD")=SDT
; . S RETURN(CNT,"SC")=SC
; . S RETURN(CNT,"DFN")=DFN
; . S SDDA="",CN=0
; . F S CN=$O(^SC(SC,"S",SDT,1,CN)) Q:'+CN!(SDDA>0) D
; . . S CNPAT=$P($G(^SC(SC,"S",SDT,1,CN,0)),U)
; . . Q:CNPAT'=DFN
; . . S SDDA=CN
; . S RETURN(CNT,"SDDA")=SDDA
; . S RETURN(CNT,"SDATA")=SDATA
; . S:SDDA>0 RETURN(CNT,"CDATA")=$G(^SC(SC,"S",SDT,1,SDDA,0))
; Q
;
GETDST(SC,SD) ; Get day slot Called by RPC MBAA APPOINTMENT MAKE
;T13 change to use a FM call to get the data from the file
N X S IENS=$P(SD,".")_","_SC_",",X=$$GET1^DIQ(44.005,IENS,1)
Q X ;ICR#: 6044 SC(
;Q $G(^SC(SC,"ST",SD,1)) ;ICR#: 6044 SC(
;
GETDPATT(RETURN,SC,SD,DAY) ; Called by RPC MBAA APPOINTMENT MAKE
S RETURN("IEN")=$O(^SC(SC,"T"_DAY,SD)) ;ICR#: 6044 SC(
S:RETURN("IEN")'="" RETURN("PAT")=$G(^SC(SC,"T"_DAY,RETURN("IEN"),1)) ;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
;UPDPATT(DATA,SC,SD) ; Update day pattern
; N IENS,I
; S IENS=SD_","_SC_","
; N FDA
; F I=0:0 S I=$O(DATA(I)) Q:I="" D
; . S FDA(44.005,IENS,I)=DATA(I)
; N ERR
; D UPDATE^DIE("","FDA",,"ERR")
; Q
;
ADDPATT(DATA,SC,SD) ; Add day pattern Called by RPC MBAA APPOINTMENT MAKE
N IENS,I,FDA,ERR
S IENS="+1,"_SC_","
S IENS(1)=SD
F I=0:0 S I=$O(DATA(I)) Q:I="" D
. S FDA(44.005,IENS,I)=DATA(I)
D UPDATE^DIE("","FDA","IENS","ERR")
Q
;
LSTAENC(RETURN,SEARCH,START,NUMBER) ; Returns active encounters. MBAA RPC: MBAA APPOINTMENT MAKE
N FILE,FIELDS,RET,SCR
S FILE="409.68",FIELDS="@;.01I;.04I;.06"
S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
S SCR="I $P(^(0),""^"",2)="_SEARCH_"&($D(^SCE(""ADFN"","_SEARCH_",$P(^(0),""^"",1))))"
K SEARCH
D LIST^DIC(FILE,"",.FIELDS,"",$G(NUMBER),.START,.SEARCH,"B",.SCR,"","RETURN","ERR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMBAAMDA1 13578 printed Oct 16, 2024@18:15:36 Page 2
MBAAMDA1 ;OIT-PD/CBR - 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 ; 10038 HOLIDAY FILE
+6 ; 6044 SC(
+7 ; 10103 XLFDT
+8 ;
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 NEW FILE,SFILES,FLDS
+2 SET FILE=44
+3 SET FLDS("*")=""
+4 SET SFILES("2501")=""
SET SFILES("2501","N")="PRIVILEGED USER"
SET SFILES("2501","F")="44.04"
+5 SET SFILES("1910")=""
SET SFILES("1910","N")="SI"
SET SFILES("1910","F")="44.03"
+6 DO GETREC^MBAAMDAL(.RETURN,CLN,FILE,.FLDS,.SFILES,$GET(INT),$GET(EXT),$GET(REZ))
+7 QUIT
+8 ;
GETCLNX(RETURN,SC) ; Get clinic detailx Called by RPC MBAA APPOINTMENT MAKE
+1 NEW IND
+2 FOR IND=0:0
SET IND=$ORDER(RETURN(IND))
if IND=""
QUIT
Begin DoDot:1
+3 SET RETURN(IND)=$$GET1^DIQ(44,SC_",",IND,"I")
End DoDot:1
+4 SET RETURN=1
+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 ;LSTCLNS(RETURN,SEARCH,START,NUMBER) ; Return clinics filtered by name.
+8 ; N FILE,FIELDS,RET,SCR
+9 ; S FILE="44",FIELDS="@;.01"
+10 ; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
+11 ; S SCR="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))"
+12 ; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"B",.SCR,"","RETURN")
+13 ; Q
+14 ; ;
GETCSC(FLDS,CSC) ; Get Clinic Stop Code MBAA RPC: MBAA APPOINTMENT MAKE
+1 NEW FLD,C
+2 DO GETS^DIQ(40.7,CSC,"*","I","C")
+3 SET FLD=""
+4 FOR
SET FLD=$ORDER(C(40.7,""_CSC_",",FLD))
if FLD=""
QUIT
Begin DoDot:1
+5 SET FLDS(FLD)=C(40.7,""_CSC_",",FLD,"I")
End DoDot:1
+6 QUIT
+7 ;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
+8 ;CLNURGHT(CLN,USR,DATA) ; Return user right
+9 ; S DATA=$G(^SC(CLN,"SDPRIV",USR,0))
+10 ; Q
+11 ;
+12 ;LSTTMPL(RETURN,CLN) ; List defined day template
+13 ; N FILE,SFILES,FLDS
+14 ; S FILE=44
+15 ; S SFILES("1922")="",SFILES("1922","N")="SUNDAY TEMPLATE",SFILES("1922","F")="44.06"
+16 ; S SFILES("1923")="",SFILES("1923","N")="MONDAY TEMPLATE",SFILES("1923","F")="44.07"
+17 ; S SFILES("1924")="",SFILES("1924","N")="TUESDAY TEMPLATE",SFILES("1924","F")="44.08"
+18 ; S SFILES("1925")="",SFILES("1925","N")="WEDNESDAY TEMPLATE",SFILES("1925","F")="44.09"
+19 ; S SFILES("1926")="",SFILES("1926","N")="THURSDAY TEMPLATE",SFILES("1926","F")="44.08"
+20 ; S SFILES("1927")="",SFILES("1927","N")="FRIDAY TEMPLATE",SFILES("1927","F")="44.09"
+21 ; S SFILES("1928")="",SFILES("1928","N")="SATURDAY TEMPLATE",SFILES("1928","F")="44.0001"
+22 ; D GETREC^MBAAMDAL(.RETURN,CLN,FILE,.FLDS,.SFILES)
+23 ; Q
+24 ;
+25 ;NXTAV(CLN,SD) ; Get next available day.
+26 ; Q $O(^SC(CLN,"ST",SD))
+27 ; ;
GETHOL(RETURN,SDATE) ; Get holiday. Called by RPC MBAA APPOINTMENT MAKE
+1 SET RETURN=0
+2 ;S:$D(^HOLIDAY(SDATE)) RETURN(0)=$G(^HOLIDAY(SDATE,0))
+3 NEW X,X1
+4 ;ICR#: 10038 HOLIDAY FILE
SET X=$$GET1^DIQ(40.5,SDATE,.01,"I")
+5 ;ICR#: 10038 HOLIDAY FILE
SET X1=$$GET1^DIQ(40.5,SDATE,2,"I")
+6 IF $GET(X)'=""
SET RETURN(0)=X_"^"_X1
+7 KILL X,X1
+8 SET RETURN=1
+9 QUIT
+10 ;
+11 ;GETPATT(RETURN,SC,SD) ; Get date pattern Called by RPC MBAA APPOINTMENT MAKE
GETPATT(RETURN,SC,SD) ; Get date pattern Called by RPC MBAA APPOINTMENT MAKE
+1 SET RETURN=0
+2 ;T13 change to use FM reads
+3 NEW X
SET IENS=$PIECE(SD,".")_","_SC_","
SET X=$$GET1^DIQ(44.005,IENS,1)
SET RETURN(0)=$GET(X)
+4 ;S:$D(^SC(SC,"ST",$P(SD,"."),1)) RETURN(0)=^SC(SC,"ST",$P(SD,"."),1) ;ICR#: 6044 SC(
+5 ;N X S IENS=$P(SD,".")_","_SC_",",X=$$GET1^DIQ(44.005,IENS,"CAN"),RETURN(0)=$G(X)
+6 ;T13 the line below is removed as this node is not defined in the DD.
+7 ;S:$D(^SC(SC,"ST",$P(SD,"."),"CAN")) RETURN(1)=^SC(SC,"ST",$P(SD,"."),"CAN") ;ICR#: 6044 SC(
+8 SET RETURN=1
+9 QUIT
+10 ;
GETSCAP(RETURN,SC,DFN,SD) ; Get clinic appointment Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT, MBAA PATIENT PENDING APPT
+1 NEW ZL,CO
+2 ;ICR#: 6044 SC(
IF $DATA(^SC(SC,"S",SD))
Begin DoDot:1
+3 SET ZL=0
+4 ;ICR#: 6044 SC(
FOR
SET ZL=$ORDER(^SC(SC,"S",SD,1,ZL))
if 'ZL
QUIT
Begin DoDot:2
+5 ;ICR#: 6044 SC(
IF '$DATA(^SC(SC,"S",SD,1,ZL,0))
QUIT
+6 SET IENS=$GET(ZL)_","_$GET(SD)_","_$GET(SC)_","
SET FLDS=".01;1;2;3;4;7;8;10;310;30;9;688"
+7 NEW LEN,XRAY,OTHER,WARD,CLERK,DTMADE,XRAYRST,APTCAN,ELIG,OB,ARRAY,ERR,CON1
+8 NEW ARRAY,ERR
DO GETS^DIQ(44.003,IENS,FLDS,"IE","ARRAY","ERR")
+9 IF $GET(ARRAY(44.003,IENS,.01,"I"))'=DFN
QUIT
+10 SET LEN=$GET(ARRAY(44.003,IENS,1,"I"))
SET XRAY=$GET(ARRAY(44.003,IENS,2,"I"))
SET OTHER=$GET(ARRAY(44.003,IENS,3,"I"))
+11 SET WARD=$GET(ARRAY(44.003,IENS,4,"I"))
SET CLERK=$GET(ARRAY(44.003,IENS,7,"I"))
SET DTMADE=$GET(ARRAY(44.003,IENS,8,"I"))
SET OB=$GET(ARRAY(44.003,IENS,9,"I"))
+12 SET XRAYRST=$GET(ARRAY(44.003,IENS,10,"I"))
SET APTCAN=$GET(ARRAY(44.003,IENS,310,"I"))
SET ELIG=$GET(ARRAY(44.003,IENS,30,"I"))
SET CON1=$GET(ARRAY(44.003,IENS,688,"I"))
+13 ;N CON1 S CON1=$$GET1^DIQ(44,IENS,688)
+14 SET RETURN(0)=$GET(DFN)_U_$GET(LEN)_U_$GET(XRAY)_U_$GET(OTHER)_U_$GET(WARD)_U_$GET(CLERK)_U_$GET(DTMADE)_U_$GET(XRAYRST)_U_$GET(APTCAN)_U_$GET(ELIG)_U_$GET(CON1)
+15 if $GET(OB)'=""
SET RETURN("OB")=$GET(OB)
+16 SET RETURN=ZL
End DoDot:2
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
GETCAPT(RETURN,SC,SD,IFN,FLAG) ; Get clinic appointment by IFN Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
+1 NEW CAPT
+2 ;ICR#: 6044 SC(
SET DIQ="CAPT("
SET DIC="^SC(SC,""S"",SD,1,"
SET DIQ(0)=$GET(FLAG)
+3 SET DA=IFN
SET DR=".01;1;3;7;8;9;30;309;302;303;304;306;688"
+4 DO EN^DIQ1
+5 MERGE RETURN=CAPT(44.003,IFN)
+6 SET RETURN(222)=SC
+7 SET RETURN(333)=IFN
+8 QUIT
+9 ;
LOCKST(SC,SD) ; Lock availability node Called by RPC MBAA APPOINTMENT MAKE
+1 ;ICR#: 6044 SC(
LOCK +^SC(SC,"ST",$PIECE(SD,"."),1):5
if '$TEST
QUIT 0
+2 QUIT 1
+3 ;
UNLCKST(SC,SD) ; Lock availability node Called by RPC MBAA APPOINTMENT MAKE
+1 ;ICR#: 6044 SC(
LOCK -^SC(SC,"ST",$PIECE(SD,"."),1)
+2 QUIT
+3 ;
LOCKS(SC,SD) ; Lock clinic date node Called by RPC MBAA APPOINTMENT MAKE
+1 ;ICR#: 6044 SC(
LOCK +^SC(SC,"S",$PIECE(SD,"."),1):5
if '$TEST
QUIT 0
+2 QUIT 1
+3 ;
UNLCKS(SC,SD) ; Unlock clinic date node Called by RPC MBAA APPOINTMENT MAKE
+1 ;ICR#: 6044 SC(
LOCK -^SC(SC,"S",$PIECE(SD,"."),1)
+2 QUIT
+3 ;
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(
+2 ;T13 CHANGE
+3 NEW ERR,FDA,IENS
+4 SET IENS=$PIECE(SD,".")_","_SC_","
+5 ;S IENS(2)=$P(SD,".")
+6 ;S FDA(44.005,IENS,.01)=$P(SD,".")
+7 SET FDA(44.005,IENS,1)=$GET(S)
+8 DO FILE^DIE("","FDA","ERR")
+9 QUIT
+10 ;
+11 ;MAKE(SC,SD,DFN,LEN,SM,USR,OTHR,RQXRAY) ; Make clinic appointment Called by RPC MBAA APPOINTMENT MAKE
MAKE(SC,SD,DFN,LEN,SM,USR,OTHR,RQXRAY) ; Make clinic appointment Called by the RPC MBAA APPOINTMENT MAKE
+1 NEW ERR,FDA,IENS
+2 ;WCJ;MBAA*1*7 added ? because it might already be there. Otherwise false error is returned on occassion.
SET IENS="?+2,"_SC_","
+3 SET IENS(2)=+SD
+4 SET FDA(44.001,IENS,.01)=+SD
+5 DO UPDATE^DIE("","FDA","IENS","ERR")
+6 SET SD=$GET(IENS(2))
+7 KILL FDA,IENS
+8 SET IENS="+1,"_+SD_","_SC_","
+9 SET FDA(44.003,IENS,.01)=DFN
+10 SET FDA(44.003,IENS,1)=LEN
+11 SET FDA(44.003,IENS,3)=$GET(OTHR)
+12 SET FDA(44.003,IENS,7)=USR
+13 ;ICR#: 10103 XLFDT
SET FDA(44.003,IENS,8)=$PIECE($$NOW^XLFDT,".")
+14 if $GET(SM)
SET FDA(44.003,IENS,9)="O"
+15 ;T13 change
+16 ;I $D(RQXRAY),RQXRAY>0 S ^SC("ARAD",SC,SD,DFN)="" ;ICR#: 6044 SC(
+17 ;ICR#: 6044 SC(
IF $DATA(RQXRAY)
IF RQXRAY>0
SET FDA(44.003,IENS,10)="Y"
+18 DO UPDATE^DIE("","FDA","IENS","ERR")
+19 QUIT
+20 ;
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)
+2 NEW HSI,SB,SDDIF,SI,SL,SS,ST,STARTDAY,STR
+3 SET SC1=SC
+4 ;ICR#: 6044 SC(
SET ^SC("ARAD",SC,SD,DFN)="N"
+5 ;S TLNK=$P($G(^SC(SC,"S",SD,1,CIFN,"CONS")),U) ;ICR#: 6044 SC(
+6 ;ICR#: 6044 SC(
KILL ^SC(SC,"S",SD,1,CIFN)
+7 ;ICR#: 6044 SC(
if $ORDER(^SC(SC,"S",SD,0))'>0
KILL ^SC(SC,"S",SD,0)
+8 ;T13 CHANGE
+9 ;K:TLNK'="" ^SC("AWAS1",TLNK),TLNK ;ICR#: 6044 SC(
+10 ;ICR#: 6044 SC(
if '$DATA(^SC(SC,"ST",SD\1,1))
QUIT
+11 ;T13 Change
+12 NEW XL1,IENS
+13 SET IENS=SC_","
DO GETS^DIQ(44,IENS,"1914;1917","I","XL1")
SET SL=$GET(XL1(44,IENS,1917,"I"))
SET X=$GET(XL1(44,IENS,1914,"I"))
+14 ;MBAA*1*5 - correct cancellation - calculation of X value
+15 ;ICR#: 6044 SC(
SET SL=$$GET1^DIQ(44,SC,1917,"I")
SET STARTDAY=$SELECT($LENGTH(X):X,1:8)
SET SB=STARTDAY-1/100
SET X=SL
SET HSI=$SELECT(X:X,1:4)
SET SI=$SELECT(X="":4,X<3:4,X:X,1:4)
SET STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
SET SDDIF=$SELECT(HSI<3:8/HSI,1:2)
KILL Y
+16 ;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(
+17 ;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(
+18 NEW IENS
+19 ;MBAA*1*5 - include length of appointment in calculation
if $GET(CAPT("LENGTH"))
SET SL=CAPT("LENGTH")
+20 SET IENS=$PIECE(SD,".")_","_SC_","
SET S=$$GET1^DIQ(44.005,IENS,1)
SET Y=SD#1-SB*100
SET ST=Y#1*SI\.6+(Y\1*SI)
SET SS=SL*HSI/60
+21 ;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(
+22 IF Y'<1
FOR I=ST+ST:SDDIF
SET Y=$EXTRACT(STR,$FIND(STR,$EXTRACT(S,I+1)))
if Y=""
QUIT
SET S=$EXTRACT(S,1,I)_Y_$EXTRACT(S,I+2,999)
SET SS=SS-1
if SS'>0
QUIT
+23 ;Code below changed to correct the naked global reference
+24 ;S ^(1)=S
+25 ;S ^SC(SC,"ST",SD\1,1)=S ;ICR#: 6044 SC(
+26 ;T13 CHANGE
+27 SET SC=SC1
KILL SC1
+28 DO SETST(SC,SD,S)
+29 QUIT
+30 ;
COVERB(SC,SD,IFN) ; Kill first overbook appointment Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
+1 ;ICR#: 6044 SC(
IF $DATA(^SC(SC,"S",SD,1,IFN,"OB"))
QUIT 0
+2 NEW X,OIFN
+3 SET X=IFN
SET OIFN=0
+4 ;ICR#: 6044 SC(
FOR
SET X=$ORDER(^SC(SC,"S",SD,1,X))
if X=""!(OIFN>0)
QUIT
Begin DoDot:1
+5 ;ICR#: 6044 SC(
IF $DATA(^SC(SC,"S",SD,1,X,"OB"))
KILL ^SC(SC,"S",SD,1,X,"OB")
SET OIFN=X
End DoDot:1
+6 QUIT OIFN
+7 ;
GETFSTA(SC) ; Get first available day. Called by RPC MBAA APPOINTMENT MAKE
+1 NEW I
+2 SET I=0
+3 ;ICR#: 6044 SC(
QUIT $ORDER(^SC(SC,"T",I))
+4 ;
GETDAYA(RETURN,SC,SD) ; Get all day appointments Called by RPC MBAA APPOINTMENT MAKE
+1 NEW IND,I,D
+2 SET I=$PIECE(SD,".",1)
+3 ;ICR#: 6044 SC(
FOR D=I-.01:0
SET D=$ORDER(^SC(SC,"S",D))
if $PIECE(D,".",1)-I
QUIT
Begin DoDot:1
+4 SET %=0
+5 ;ICR#: 6044 SC(
FOR
SET %=$ORDER(^SC(SC,"S",D,1,%))
if %'>0
QUIT
Begin DoDot:2
+6 ;ICR#: 6044 SC(
if '$DATA(^SC(SC,"S",D,1,%,0))
QUIT
+7 ; next two lines changed to correct the naked global reference
+8 ;S RETURN(%,"STATUS")=$P(^(0),U,9)
+9 ;S RETURN(%,"OB")=$D(^("OB"))
+10 ;T13 Change
+11 SET DIQ="CAPT("
SET DIC="^SC(SC,""S"",D,1,"
SET DA=%
SET DR="310;9"
DO EN^DIQ1
+12 SET %=DA
+13 SET RETURN(%,"STATUS")=$GET(CAPT(44.003,%,310))
+14 SET RETURN(%,"OB")=$GET(CAPT(44.003,%,9))
+15 KILL DIQ,DA,DR,DIC,CAPT
+16 IF $GET(I)=""
SET I=$PIECE(SD,".",1)
+17 ;S RETURN(%,"STATUS")=$P(^SC(SC,"S",D,1,%,0),U,9)
+18 ;S RETURN(%,"OB")=$D(^SC(SC,"S",D,1,%,"OB"))
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;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
+21 ;LSTCAPTS(RETURN,SC,SDBEG,SDEND) ;
+22 ; N SDT,SDDA,CNT,APT,SDATA,CNSTLNK
+23 ; S CNT=0 S:'$D(SDBEG) SDBEG=1 S:'$D(SDEND) SDEND=99999999
+24 ; F SDT=SDBEG:0 S SDT=$O(^SC(SC,"S",SDT)) Q:'SDT!($P(SDT,".",1)>SDEND) D
+25 ; . F SDDA=0:0 S SDDA=$O(^SC(SC,"S",SDT,1,SDDA)) Q:'SDDA D
+26 ; . . S CNSTLNK=$P($G(^SC(SC,"S",SDT,1,SDDA,"CONS")),U)
+27 ; . . Q:'$D(^SC(SC,"S",SDT,1,SDDA,0))
+28 ; . . ; next line changed to correct the naked global reference
+29 ; . . ;S APT=^(0)
+30 ; . . S APT=$G(^SC(SC,"S",SDT,1,SDDA,0))
+31 ; . . S CNT=CNT+1
+32 ; . . S SDATA=^DPT(+APT,"S",SDT,0)
+33 ; . . S RETURN(CNT,"CONS")=$G(CNSTLNK)
+34 ; . . S RETURN(CNT,"SD")=SDT
+35 ; . . S RETURN(CNT,"SC")=+SDATA
+36 ; . . S RETURN(CNT,"DFN")=+APT
+37 ; . . S RETURN(CNT,"SDDA")=SDDA
+38 ; . . S RETURN(CNT,"SDATA")=SDATA
+39 ; . . S RETURN(CNT,"CDATA")=APT
+40 ; Q
+41 ; ;
+42 ;LSTPAPTS(RETURN,DFN,SDBEG,SDEND) ; Get patient appointments
+43 ; N SDT,CNT,SDDA,SC,CN,CNPAT
+44 ; S CNT=0 S:'$D(SDBEG) SDBEG=DT S:'$D(SDEND) SDEND=99999999
+45 ; F SDT=SDBEG:0 S SDT=$O(^DPT(DFN,"S",SDT)) Q:'SDT!($P(SDT,".",1)>SDEND) D
+46 ; . Q:'$D(^(SDT,0))
+47 ; . S CNT=CNT+1
+48 ; . S SDATA=^DPT(+DFN,"S",SDT,0)
+49 ; . S SC=+SDATA
+50 ; . S RETURN(CNT,"CONS")=$G(CNSTLNK)
+51 ; . S RETURN(CNT,"SD")=SDT
+52 ; . S RETURN(CNT,"SC")=SC
+53 ; . S RETURN(CNT,"DFN")=DFN
+54 ; . S SDDA="",CN=0
+55 ; . F S CN=$O(^SC(SC,"S",SDT,1,CN)) Q:'+CN!(SDDA>0) D
+56 ; . . S CNPAT=$P($G(^SC(SC,"S",SDT,1,CN,0)),U)
+57 ; . . Q:CNPAT'=DFN
+58 ; . . S SDDA=CN
+59 ; . S RETURN(CNT,"SDDA")=SDDA
+60 ; . S RETURN(CNT,"SDATA")=SDATA
+61 ; . S:SDDA>0 RETURN(CNT,"CDATA")=$G(^SC(SC,"S",SDT,1,SDDA,0))
+62 ; Q
+63 ;
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
+2 NEW X
SET IENS=$PIECE(SD,".")_","_SC_","
SET X=$$GET1^DIQ(44.005,IENS,1)
+3 ;ICR#: 6044 SC(
QUIT X
+4 ;Q $G(^SC(SC,"ST",SD,1)) ;ICR#: 6044 SC(
+5 ;
GETDPATT(RETURN,SC,SD,DAY) ; Called by RPC MBAA APPOINTMENT MAKE
+1 ;ICR#: 6044 SC(
SET RETURN("IEN")=$ORDER(^SC(SC,"T"_DAY,SD))
+2 ;ICR#: 6044 SC(
if RETURN("IEN")'=""
SET RETURN("PAT")=$GET(^SC(SC,"T"_DAY,RETURN("IEN"),1))
+3 QUIT
+4 ;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
+5 ;UPDPATT(DATA,SC,SD) ; Update day pattern
+6 ; N IENS,I
+7 ; S IENS=SD_","_SC_","
+8 ; N FDA
+9 ; F I=0:0 S I=$O(DATA(I)) Q:I="" D
+10 ; . S FDA(44.005,IENS,I)=DATA(I)
+11 ; N ERR
+12 ; D UPDATE^DIE("","FDA",,"ERR")
+13 ; Q
+14 ;
ADDPATT(DATA,SC,SD) ; Add day pattern Called by RPC MBAA APPOINTMENT MAKE
+1 NEW IENS,I,FDA,ERR
+2 SET IENS="+1,"_SC_","
+3 SET IENS(1)=SD
+4 FOR I=0:0
SET I=$ORDER(DATA(I))
if I=""
QUIT
Begin DoDot:1
+5 SET FDA(44.005,IENS,I)=DATA(I)
End DoDot:1
+6 DO UPDATE^DIE("","FDA","IENS","ERR")
+7 QUIT
+8 ;
LSTAENC(RETURN,SEARCH,START,NUMBER) ; Returns active encounters. MBAA RPC: MBAA APPOINTMENT MAKE
+1 NEW FILE,FIELDS,RET,SCR
+2 SET FILE="409.68"
SET FIELDS="@;.01I;.04I;.06"
+3 if $DATA(START)=0
SET START=""
if $DATA(SEARCH)=0
SET SEARCH=""
+4 SET SCR="I $P(^(0),""^"",2)="_SEARCH_"&($D(^SCE(""ADFN"","_SEARCH_",$P(^(0),""^"",1))))"
+5 KILL SEARCH
+6 DO LIST^DIC(FILE,"",.FIELDS,"",$GET(NUMBER),.START,.SEARCH,"B",.SCR,"","RETURN","ERR")
+7 QUIT
