Routine: MBAAMDA3

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))

 ;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")

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")

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

 ;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  Feb 18, 2025@23:41:04                                                                                                                                                                                                    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      ;

MBAAMDA3.m