MBAAMDA3 ;OIT-PD/CBR - APPOINTMENT API ;02/10/2016
;;1.0;Scheduling Calendar View;**1,11**;Feb 13, 2015;Build 1
;
;Associated ICRs
; ICR#
; 6053 DPT
; 10076 XUSEC
;
;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
;GETPATS(RETURN,SEARCH,START,NUMBER) ; Get patients
; N FILE,FIELDS,RET,SCR,INDX
; S FILE="2",FIELDS="@;.01;.03;.09;391;1901",INDX="B"
; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
; I $D(SEARCH),SEARCH?4N S INDX="BS"
; I $L(SEARCH)>1,SEARCH?.N S INDX="SSN"
; I $L(SEARCH)>0,SEARCH?1A4N S INDX="BS5"
; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,INDX,.SCR,"","RETURN")
; Q
;
GETPAT(RETURN,PAT,INT,EXT,REZ) ; Get patient detail Called by RPC MBAA APPOINTMENT MAKE
N FILE,SFILES,FLDS
S FILE=2
S FLDS("*")=""
S SFILES(".3721")="",SFILES(".3721","N")="RATED DISABILITIES",SFILES(".3721","F")="2.04"
S SFILES("2")="",SFILES("2","N")="RACE INFORMATION",SFILES("2","F")="2.02"
S SFILES("6")="",SFILES("6","N")="ETHNICITY INFORMATION",SFILES("6","F")="2.06"
S ROUT=2
D GETREC^MBAAMDAL(.RETURN,PAT,FILE,.FLDS,.SFILES,$G(INT),$G(EXT),$G(REZ))
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
;LSTETNS(RETURN,SEARCH,START,NUMBER) ; Return ethnicity information.
; N FILE,FIELDS,RET,SCR
; S FILE="10.2",FIELDS="@;.01"
; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
; S SCR="I $S('$D(^(.02)):1,$P(^(.02),U,1)=1:0,1:1)"
; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"B",.SCR,"","RETURN")
; Q
; ;
;SETETN(PAT,ETN) ; Set patient ethnicity.
; N IENS,FDA,MSG
; S IENS="?+1,"_PAT_","
; S FDA(2.06,IENS,".01")=ETN
; S FDA(2.06,IENS,".02")=1
; D UPDATE^DIE("","FDA","IENS","MSG")
; Q
;
;LSTRACES(RETURN,SEARCH,START,NUMBER) ; Return races.
; N FILE,FIELDS,RET,SCR
; S FILE="10",FIELDS="@;.01"
; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
; S SCR="I $S('$D(^(.02)):1,$P(^(.02),U,1)=1:0,1:1)"
; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"B",.SCR,"","RETURN")
; Q
; ;
;GETPRES(RETURN,PAT) ; Get patient races
; N FILE,SFILES,FLDS
; S FILE=2
; S SFILES("2")="",SFILES("2","N")="RACE INFORMATION",SFILES("2","F")="2.02"
; D GETREC^MBAAMDAL(.RETURN,PAT,FILE,.FLDS,.SFILES,$G(INT),$G(EXT),$G(REZ))
; Q
;
;ADDRACE(PAT,RACE) ; Set patient race.
; N IENS,FDA,MSG
; S IENS="?+2,"_PAT_","
; S IENS(2)=RACE
; S FDA(2.02,IENS,".01")=RACE
; S FDA(2.02,IENS,".02")=1
; D UPDATE^DIE("","FDA","IENS","MSG")
; Q
;
MAKE(DFN,SD,SC,TYPE,STYP,STAT,RSN,USR,DT,SRT,NAAI,LAB,XRAY,EKG,DESDT) ; Make patient appointment Called by RPC MBAA APPOINTMENT MAKE
N ERR,FDA,IENS
I $D(^DPT(DFN,"S",+SD,0)),$P(^DPT(DFN,"S",+SD,0),U,2)["C" D ;ICR#: 6053 DPT
. S IENS=SD_","_DFN_","
. S FDA(2.98,IENS,".01")=SC
. S FDA(2.98,IENS,"3")="@"
. S FDA(2.98,IENS,"5")=$G(LAB)
. S FDA(2.98,IENS,"6")=$G(XRAY)
. S FDA(2.98,IENS,"7")=$G(EKG)
. S FDA(2.98,IENS,"9")=$G(RSN)
. S FDA(2.98,IENS,"9.5")=$G(TYPE)
. S FDA(2.98,IENS,14)="@"
. S FDA(2.98,IENS,15)="@"
. S FDA(2.98,IENS,16)="@"
. S FDA(2.98,IENS,"17")="@"
. S FDA(2.98,IENS,19)=$G(USR)
. S FDA(2.98,IENS,"20")=DT
. S FDA(2.98,IENS,"24")=$G(STYP)
. S FDA(2.98,IENS,"25")=$G(SRT)
. S FDA(2.98,IENS,"26")=$G(NAAI)
. S FDA(2.98,IENS,"27")=$G(DESDT)
. D FILE^DIE("","FDA","ERR")
E D
. S IENS="?+2,"_DFN_","
. S IENS(2)=+SD
. S FDA(2.98,IENS,.01)=SC
. S FDA(2.98,IENS,"3")=STAT
. S FDA(2.98,IENS,"5")=$G(LAB)
. S FDA(2.98,IENS,"6")=$G(XRAY)
. S FDA(2.98,IENS,"7")=$G(EKG)
. S FDA(2.98,IENS,"9")=$G(RSN)
. S FDA(2.98,IENS,"9.5")=$G(TYPE)
. S FDA(2.98,IENS,"19")=USR
. S FDA(2.98,IENS,"20")=DT
. S FDA(2.98,IENS,"24")=$G(STYP)
. S FDA(2.98,IENS,"25")=$G(SRT)
. S FDA(2.98,IENS,"26")=$G(NAAI)
. S FDA(2.98,IENS,"27")=$G(DESDT)
. D UPDATE^DIE("","FDA","IENS","ERR")
Q
;
CANCEL(RETURN,DFN,SD,TYP,RSN,RMK,CDT,USR,OUSR,ODT) ; Cancel appointment. Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
N IENS,FDA
S IENS=SD_","_DFN_","
S FDA(2.98,IENS,3)=TYP
S FDA(2.98,IENS,14)=USR
S FDA(2.98,IENS,15)=CDT
S FDA(2.98,IENS,16)=RSN
S FDA(2.98,IENS,19)=OUSR
S FDA(2.98,IENS,20)=ODT
S:$G(RMK)]"" FDA(2.98,IENS,17)=$E(RMK,1,160)
D FILE^DIE("","FDA","RETURN")
Q
;
GETXUS(RETURN,KEYS,USR) ; Get user access Called by RPC MBAA APPOINTMENT MAKE
N KEY
K RETURN S KEY=""
F S KEY=$O(KEYS(KEY)) Q:KEY="" S:$D(^XUSEC(KEY,USR)) RETURN(KEY)="" ;ICR#: 10076 XUSEC
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
;GETCENRL(RETURN,DFN,SC) ; Get clinic enrolls
; N IND,EC,SSC
; K RETURN S RETURN=0
; F SSC=0:0 S SSC=$O(^DPT(DFN,"DE","B",SSC)) Q:SSC="" D
; . Q:$G(SC)>0&(SSC'=$G(SC))
; . S EC=$O(^DPT(DFN,"DE","B",SSC,"")) Q:'EC
; . S RETURN(SSC,0)=EC_U_^DPT(DFN,"DE",EC,0)
; . F IND=0:0 S IND=$O(^DPT(DFN,"DE",EC,1,IND)) Q:IND="" D
; . . S RETURN(SSC,IND)=^DPT(DFN,"DE",EC,1,IND,0)
; S RETURN=1
; Q
;
;UPDENRL(ENS,DFN) ;
; N IENS,FDA,ERR,IND,SC
; S SC=$O(ENS(""))
; S IENS=ENS(SC,"IEN")_","_DFN_","
; S FDA(2.001,IENS,2)="I"
; D UPDATE^DIE("","FDA",,"ERR")
; F IND=0:0 S IND=$O(ENS(SC,"EN",IND)) Q:IND="" D
; . Q:(IND'>0)
; . S IENS=IND_","_ENS(SC,"IEN")_","_DFN_","
; . S:$D(ENS(SC,"EN",IND,"DISCHARGE")) FDA(2.011,IENS,3)=ENS(SC,"EN",IND,"DISCHARGE")
; . S:$D(ENS(SC,"EN",IND,"REASON")) FDA(2.011,IENS,4)=ENS(SC,"EN",IND,"REASON")
; . D UPDATE^DIE("","FDA",,"ERR")
; Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMBAAMDA3 5654 printed Apr 09, 2024@21:16:45 Page 2
MBAAMDA3 ;OIT-PD/CBR - APPOINTMENT API ;02/10/2016
+1 ;;1.0;Scheduling Calendar View;**1,11**;Feb 13, 2015;Build 1
+2 ;
+3 ;Associated ICRs
+4 ; ICR#
+5 ; 6053 DPT
+6 ; 10076 XUSEC
+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 ;GETPATS(RETURN,SEARCH,START,NUMBER) ; Get patients
+10 ; N FILE,FIELDS,RET,SCR,INDX
+11 ; S FILE="2",FIELDS="@;.01;.03;.09;391;1901",INDX="B"
+12 ; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
+13 ; I $D(SEARCH),SEARCH?4N S INDX="BS"
+14 ; I $L(SEARCH)>1,SEARCH?.N S INDX="SSN"
+15 ; I $L(SEARCH)>0,SEARCH?1A4N S INDX="BS5"
+16 ; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,INDX,.SCR,"","RETURN")
+17 ; Q
+18 ;
GETPAT(RETURN,PAT,INT,EXT,REZ) ; Get patient detail Called by RPC MBAA APPOINTMENT MAKE
+1 NEW FILE,SFILES,FLDS
+2 SET FILE=2
+3 SET FLDS("*")=""
+4 SET SFILES(".3721")=""
SET SFILES(".3721","N")="RATED DISABILITIES"
SET SFILES(".3721","F")="2.04"
+5 SET SFILES("2")=""
SET SFILES("2","N")="RACE INFORMATION"
SET SFILES("2","F")="2.02"
+6 SET SFILES("6")=""
SET SFILES("6","N")="ETHNICITY INFORMATION"
SET SFILES("6","F")="2.06"
+7 SET ROUT=2
+8 DO GETREC^MBAAMDAL(.RETURN,PAT,FILE,.FLDS,.SFILES,$GET(INT),$GET(EXT),$GET(REZ))
+9 QUIT
+10 ;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
+11 ;LSTETNS(RETURN,SEARCH,START,NUMBER) ; Return ethnicity information.
+12 ; N FILE,FIELDS,RET,SCR
+13 ; S FILE="10.2",FIELDS="@;.01"
+14 ; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
+15 ; S SCR="I $S('$D(^(.02)):1,$P(^(.02),U,1)=1:0,1:1)"
+16 ; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"B",.SCR,"","RETURN")
+17 ; Q
+18 ; ;
+19 ;SETETN(PAT,ETN) ; Set patient ethnicity.
+20 ; N IENS,FDA,MSG
+21 ; S IENS="?+1,"_PAT_","
+22 ; S FDA(2.06,IENS,".01")=ETN
+23 ; S FDA(2.06,IENS,".02")=1
+24 ; D UPDATE^DIE("","FDA","IENS","MSG")
+25 ; Q
+26 ;
+27 ;LSTRACES(RETURN,SEARCH,START,NUMBER) ; Return races.
+28 ; N FILE,FIELDS,RET,SCR
+29 ; S FILE="10",FIELDS="@;.01"
+30 ; S:$D(START)=0 START="" S:$D(SEARCH)=0 SEARCH=""
+31 ; S SCR="I $S('$D(^(.02)):1,$P(^(.02),U,1)=1:0,1:1)"
+32 ; D LIST^DIC(FILE,"",FIELDS,"",$G(NUMBER),.START,SEARCH,"B",.SCR,"","RETURN")
+33 ; Q
+34 ; ;
+35 ;GETPRES(RETURN,PAT) ; Get patient races
+36 ; N FILE,SFILES,FLDS
+37 ; S FILE=2
+38 ; S SFILES("2")="",SFILES("2","N")="RACE INFORMATION",SFILES("2","F")="2.02"
+39 ; D GETREC^MBAAMDAL(.RETURN,PAT,FILE,.FLDS,.SFILES,$G(INT),$G(EXT),$G(REZ))
+40 ; Q
+41 ;
+42 ;ADDRACE(PAT,RACE) ; Set patient race.
+43 ; N IENS,FDA,MSG
+44 ; S IENS="?+2,"_PAT_","
+45 ; S IENS(2)=RACE
+46 ; S FDA(2.02,IENS,".01")=RACE
+47 ; S FDA(2.02,IENS,".02")=1
+48 ; D UPDATE^DIE("","FDA","IENS","MSG")
+49 ; Q
+50 ;
MAKE(DFN,SD,SC,TYPE,STYP,STAT,RSN,USR,DT,SRT,NAAI,LAB,XRAY,EKG,DESDT) ; Make patient appointment Called by RPC MBAA APPOINTMENT MAKE
+1 NEW ERR,FDA,IENS
+2 ;ICR#: 6053 DPT
IF $DATA(^DPT(DFN,"S",+SD,0))
IF $PIECE(^DPT(DFN,"S",+SD,0),U,2)["C"
Begin DoDot:1
+3 SET IENS=SD_","_DFN_","
+4 SET FDA(2.98,IENS,".01")=SC
+5 SET FDA(2.98,IENS,"3")="@"
+6 SET FDA(2.98,IENS,"5")=$GET(LAB)
+7 SET FDA(2.98,IENS,"6")=$GET(XRAY)
+8 SET FDA(2.98,IENS,"7")=$GET(EKG)
+9 SET FDA(2.98,IENS,"9")=$GET(RSN)
+10 SET FDA(2.98,IENS,"9.5")=$GET(TYPE)
+11 SET FDA(2.98,IENS,14)="@"
+12 SET FDA(2.98,IENS,15)="@"
+13 SET FDA(2.98,IENS,16)="@"
+14 SET FDA(2.98,IENS,"17")="@"
+15 SET FDA(2.98,IENS,19)=$GET(USR)
+16 SET FDA(2.98,IENS,"20")=DT
+17 SET FDA(2.98,IENS,"24")=$GET(STYP)
+18 SET FDA(2.98,IENS,"25")=$GET(SRT)
+19 SET FDA(2.98,IENS,"26")=$GET(NAAI)
+20 SET FDA(2.98,IENS,"27")=$GET(DESDT)
+21 DO FILE^DIE("","FDA","ERR")
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 SET IENS="?+2,"_DFN_","
+24 SET IENS(2)=+SD
+25 SET FDA(2.98,IENS,.01)=SC
+26 SET FDA(2.98,IENS,"3")=STAT
+27 SET FDA(2.98,IENS,"5")=$GET(LAB)
+28 SET FDA(2.98,IENS,"6")=$GET(XRAY)
+29 SET FDA(2.98,IENS,"7")=$GET(EKG)
+30 SET FDA(2.98,IENS,"9")=$GET(RSN)
+31 SET FDA(2.98,IENS,"9.5")=$GET(TYPE)
+32 SET FDA(2.98,IENS,"19")=USR
+33 SET FDA(2.98,IENS,"20")=DT
+34 SET FDA(2.98,IENS,"24")=$GET(STYP)
+35 SET FDA(2.98,IENS,"25")=$GET(SRT)
+36 SET FDA(2.98,IENS,"26")=$GET(NAAI)
+37 SET FDA(2.98,IENS,"27")=$GET(DESDT)
+38 DO UPDATE^DIE("","FDA","IENS","ERR")
End DoDot:1
+39 QUIT
+40 ;
CANCEL(RETURN,DFN,SD,TYP,RSN,RMK,CDT,USR,OUSR,ODT) ; Cancel appointment. Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
+1 NEW IENS,FDA
+2 SET IENS=SD_","_DFN_","
+3 SET FDA(2.98,IENS,3)=TYP
+4 SET FDA(2.98,IENS,14)=USR
+5 SET FDA(2.98,IENS,15)=CDT
+6 SET FDA(2.98,IENS,16)=RSN
+7 SET FDA(2.98,IENS,19)=OUSR
+8 SET FDA(2.98,IENS,20)=ODT
+9 if $GET(RMK)]""
SET FDA(2.98,IENS,17)=$EXTRACT(RMK,1,160)
+10 DO FILE^DIE("","FDA","RETURN")
+11 QUIT
+12 ;
GETXUS(RETURN,KEYS,USR) ; Get user access Called by RPC MBAA APPOINTMENT MAKE
+1 NEW KEY
+2 KILL RETURN
SET KEY=""
+3 ;ICR#: 10076 XUSEC
FOR
SET KEY=$ORDER(KEYS(KEY))
if KEY=""
QUIT
if $DATA(^XUSEC(KEY,USR))
SET RETURN(KEY)=""
+4 QUIT
+5 ;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
+6 ;GETCENRL(RETURN,DFN,SC) ; Get clinic enrolls
+7 ; N IND,EC,SSC
+8 ; K RETURN S RETURN=0
+9 ; F SSC=0:0 S SSC=$O(^DPT(DFN,"DE","B",SSC)) Q:SSC="" D
+10 ; . Q:$G(SC)>0&(SSC'=$G(SC))
+11 ; . S EC=$O(^DPT(DFN,"DE","B",SSC,"")) Q:'EC
+12 ; . S RETURN(SSC,0)=EC_U_^DPT(DFN,"DE",EC,0)
+13 ; . F IND=0:0 S IND=$O(^DPT(DFN,"DE",EC,1,IND)) Q:IND="" D
+14 ; . . S RETURN(SSC,IND)=^DPT(DFN,"DE",EC,1,IND,0)
+15 ; S RETURN=1
+16 ; Q
+17 ;
+18 ;UPDENRL(ENS,DFN) ;
+19 ; N IENS,FDA,ERR,IND,SC
+20 ; S SC=$O(ENS(""))
+21 ; S IENS=ENS(SC,"IEN")_","_DFN_","
+22 ; S FDA(2.001,IENS,2)="I"
+23 ; D UPDATE^DIE("","FDA",,"ERR")
+24 ; F IND=0:0 S IND=$O(ENS(SC,"EN",IND)) Q:IND="" D
+25 ; . Q:(IND'>0)
+26 ; . S IENS=IND_","_ENS(SC,"IEN")_","_DFN_","
+27 ; . S:$D(ENS(SC,"EN",IND,"DISCHARGE")) FDA(2.011,IENS,3)=ENS(SC,"EN",IND,"DISCHARGE")
+28 ; . S:$D(ENS(SC,"EN",IND,"REASON")) FDA(2.011,IENS,4)=ENS(SC,"EN",IND,"REASON")
+29 ; . D UPDATE^DIE("","FDA",,"ERR")
+30 ; Q
+31 ;
