MBAAMAP3 ;OIT-PD/VSL - APPOINTMENT API ;02/10/2016
;;1.0;Scheduling Calendar View;**1**;Feb 13, 2015;Build 85
;
;Associated ICRs
; ICR#
;
;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
;LSTPATS(RETURN,SEARCH,START,NUMBER) ; Get patients by name
;N RET,DL,IN,DG
;S:'$D(START) START="" S:'$D(SEARCH) SEARCH=""
;S:'$G(NUMBER) NUMBER=""
;S RETURN=0
;D GETPATS^MBAAMDA3(.RET,$$UP^XLFSTR(SEARCH),.START,NUMBER)
;S RETURN(0)=RET("DILIST",0)
;S DL="DILIST"
;F IN=1:1:$P(RETURN(0),U,1) D
;. D SENS^DGSEC4(.DG,RET(DL,2,IN),DUZ)
;. S RETURN(IN)=""
;. S RETURN(IN,"ID")=RET(DL,2,IN)
;. S RETURN(IN,"NAME")=RET(DL,"ID",IN,".01")
;. S RETURN(IN,"BIRTHDATE")=$S(DG(1)=2:"*SENSITIVE*",1:RET(DL,"ID",IN,".03"))
;. S RETURN(IN,"SSN")=$S(DG(1)=2:"*SENSITIVE*",1:RET(DL,"ID",IN,".09"))
;. S RETURN(IN,"TYPE")=RET(DL,"ID",IN,"391")
;. S RETURN(IN,"VETERAN")=RET(DL,"ID",IN,"1901")
;S RETURN=1
;Q 1
;
;GETPAT(RETURN,PATIENT,LVL) ; Get a patient
; N TEXT
; S RETURN=0 S:'$G(LVL) LVL=7
; I '$G(PATIENT) S TEXT(1)="PATIENT" D ERRX^MBAAAPIE(.RETURN,"INVPARAM",.TEXT) Q 0
; I LVL>1 D SENS^DGSEC4(.DG,PATIENT,DUZ) D ERRX^MBAAAPIE(.RETURN,"PATSENS",.TEXT) Q 0
; D GETPAT^MBAAMDA3(.RETURN,PATIENT,1,1,1)
; S RETURN=1
; Q RETURN
; ;
;LSTETNS(RETURN,SEARCH,START,NUMBER) ; Get ethnicities
; N LST
; D LSTETNS^MBAAMDA3(.LST,$G(SEARCH),.START,$G(NUMBER))
; D BLDLST^MBAAMAPI(.RETURN,.LST)
; Q RETURN
; ;
;SETETN(RETURN,PAT,ETN) ; Set patient ethnicity.
; D SETETN^MBAAMDA3(PAT,$P(ETN,U,1))
; S RETURN=1
; Q 1
; ;
;LSTRACES(RETURN,SEARCH,START,NUMBER) ; Get races
; N LST
; D LSTRACES^MBAAMDA3(.LST,$G(SEARCH),.START,$G(NUMBER))
; D BLDLST^MBAAMAPI(.RETURN,.LST)
; Q RETURN
; ;
;SETRACE(RETURN,PAT,RACE) ; Set patient race.
; D ADDRACE^MBAAMDA3(PAT,+RACE)
; S RETURN=1
; Q 1
; ;
;GETPRES(RETURN,PAT) ; Get patient races
; N LST,IND,CNT
; K RETURN
; D GETPRES^MBAAMDA3(.LST,PAT)
; S IND=0,CNT=0
; S RETURN(0)=0
; F S IND=$O(LST(2,IND)) Q:IND="" D
; . S CNT=CNT+1
; . S RETURN(CNT)="",RETURN(CNT,"ID")=IND
; . S RETURN(CNT,"NAME")=LST(2,IND,.01)
; . S RETURN(0)=CNT_"^*^0^"
; S RETURN=1
; Q 1
; ;
;Code at linetag CHKDISCH is removed until the next version/enhancment of MBAA
;CHKDISCH(RETURN,ENS,DFN,OENS) ; Check discharge
;N SC,TXT,IND,APTS,ERR,APT
;S RETURN=0,ERR=0
;S SC=$O(ENS(""))
;S TXT(1)=ENS(SC,"NAME")
;I OENS(SC,"STATUS")]"" D ERRX^MBAAAPIE(.RETURN,"PATDARD",.TXT) Q RETURN
;I '$D(OENS(SC,"EN")) D ERRX^MBAAAPIE(.RETURN,"PATDNEN",.TXT) Q RETURN
;F IND=0:0 S IND=$O(ENS(SC,"EN",IND)) Q:IND=""!(ERR>0) D
;. Q:$D(ENS(SC,"EN",IND,"DISCHARGE"))&(ENS(SC,"EN",IND,"DISCHARGE")=OENS(SC,"EN",IND,"DISCHARGE"))
;. D LSTPAPTS^MBAAMDA1(.APTS,DFN,ENS(SC,"EN",IND,"DISCHARGE"),9999999)
;. F APT=0:0 S APT=$O(APTS(APT)) Q:APT=""!(ERR>0) D
;. . I APTS(APT,"SC")=SC,$P(APTS(APT,"SDATA"),U,2)'["C",$P(APTS(APT,"SDATA"),U,2)'["N" S ERR=1
;I ERR D ERRX^MBAAAPIE(.RETURN,"PATDHFA") Q RETURN
;S RETURN=1
;Q RETURN
;
;DISCH(RETURN,ENS,DFN) ; Discharge from clinic
;N OENS,IND,SC,NENS
;S RETURN=0
;S SC=$O(ENS(""))
;S %=$$GETPENRL(.OENS,DFN,SC)
;S %=$$CHKDISCH(.RETURN,.ENS,DFN,.OENS)
;Q:RETURN=0 0
;F IND=0:0 S IND=$O(ENS(SC,"EN",IND)) Q:IND="" D
;. S:ENS(SC,"EN",IND,"DISCHARGE")'=OENS(SC,"EN",IND,"DISCHARGE") NENS(SC,"EN",IND,"DISCHARGE")=ENS(SC,"EN",IND,"DISCHARGE")
;. S:ENS(SC,"EN",IND,"REASON")'=OENS(SC,"EN",IND,"REASON") NENS(SC,"EN",IND,"REASON")=$E(ENS(SC,"EN",IND,"REASON"),1,80)
;S NENS(SC,"IEN")=ENS(SC,"IEN")
;D BEFORE^SCMCEV3(DFN)
;D UPDENRL^MBAAMDA3(.NENS,DFN)
;D AFTER^SCMCEV3(DFN)
;D INVOKE^SCMCEV3(DFN)
;S RETURN=1
;Q 1
;
;GETPENRL(RETURN,DFN,SC,STAT) ; Get patient enrollments filtered by status
; N ENS,EN,IND,CLN,SSC
; D GETCENRL^MBAAMDA3(.ENS,DFN,$G(SC))
; F SSC=0:0 S SSC=$O(ENS(SSC)) Q:SSC="" D
; . Q:$G(STAT)>0&($P(ENS(SSC,0),U,3)]"")
; . S RETURN(SSC,"STATUS")=$P(ENS(SSC,0),U,3)
; . S RETURN(SSC,"IEN")=$P(ENS(SSC,0),U,1)
; . D GETCLN^MBAAMDA1(.CLN,SSC)
; . S RETURN(SSC,"NAME")=CLN(.01)
; . F IND=0:0 S IND=$O(ENS(SSC,IND)) Q:IND="" D
; . . S EN=ENS(SSC,IND)
; . . S RETURN(SSC,"EN",IND,"ENROLLMENT")=$P(EN,U,1)
; . . S RETURN(SSC,"EN",IND,"OA")=$P(EN,U,2)
; . . S RETURN(SSC,"EN",IND,"DISCHARGE")=$P(EN,U,3)
; . . S RETURN(SSC,"EN",IND,"REASON")=$P(EN,U,4)
; . . S RETURN(SSC,"EN",IND,"REVIEW")=$P(EN,U,5)
; I $G(SC)>0 D
; . Q:$D(RETURN(SC))
; . D GETCLN^MBAAMDA1(.CLN,SC)
; . S RETURN(SC,"NAME")=CLN(.01)
; Q 1
;
CHKCIN(RETURN,DFN,SD,STATUS) ; Check in check MBAA RPC: MBAA APPOINTMENT MAKE
N DT
S RETURN=0
S %=$$CHKSPCI(.RETURN,DFN,SD,STATUS) Q:'% 0
S DT=$$NOW^XLFDT ;ICR#: 10103 XLFDT
I $P(SD,".")>DT D ERRX^MBAAAPIE(.RETURN,"APTCITS") Q 0
Q 1
;
CHKSPCI(RETURN,DFN,SD,STATUS) ; Check if status permit check in MBAA RPC: MBAA APPOINTMENT MAKE
N IND,STAT,STATS
S RETURN=0
D LSTCIST1^MBAAMDA2(.STAT)
D BLDLST^MBAAMAPI(.STATS,.STAT)
S IND=0
F S IND=$O(STATS(IND)) Q:IND=""!(RETURN=1) D
. I STATS(IND,"ID")=STATUS S RETURN=1 Q
I 'RETURN D ERRX^MBAAAPIE(.RETURN,"APTCIPE")
Q RETURN
;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
;CHKNS(RETURN,APT0,STATUS,LVL) ; Check no-show
; N STAT
; S RETURN=1
; S %=$$CHKSPNS(.RETURN,+STATUS) Q:'% 0
; S STAT=$P(APT0,U,2)
; I STAT="I" S RETURN=0 D ERRX^MBAAAPIE(.RETURN,"APTNSIA") Q RETURN
; I LVL>1,STAT["A" S RETURN=0 D ERRX^MBAAAPIE(.RETURN,"APTNSAR",,2) Q RETURN
; I LVL>1,STAT]"",STAT'["A" S RETURN=0 D ERRX^MBAAAPIE(.RETURN,"APTNSAL",,2) Q RETURN
; Q RETURN
; ;
;CHKSPNS(RETURN,STATUS) ; Check if status of appt permits no-show
; N IND,STAT,STATS
; S RETURN=0
; D LSTNSTA1^MBAAMDA2(.STAT)
; D BLDLST^MBAAMAPI(.STATS,.STAT)
; S IND=0
; F S IND=$O(STATS(IND)) Q:IND=""!(RETURN=1) D
; . I STATS(IND,"ID")=STATUS S RETURN=1 Q
; I 'RETURN D ERRX^MBAAAPIE(.RETURN,"APTNSCE")
; Q RETURN
; ;
CHKCAN(RETURN,DFN,SC,SD) ; Verify cancel Called by RPC MBAA APPOINTMENT MAKE
N APT,RET,%
S RETURN=0
D GETAPTS^MBAAMDA2(.APT,DFN,.SD)
I APT("APT",SD,"STATUS")["C" D Q RETURN
. D ERRX^MBAAAPIE(.RETURN,"APTCAND")
I $$ISAPTCO^MBAAMAP4(,DFN,SD) D Q RETURN
. D ERRX^MBAAAPIE(.RETURN,"APTCCHO")
S %=$$CLNRGHT^MBAAMAP1(.RET,+SC)
I RET=0 D Q RETURN
. S TXT(1)=RET("CLN"),TXT(2)=$C(10)
. D ERRX^MBAAAPIE(.RETURN,"APTCRGT",.TXT)
I '$$CHKSPC(.STAT,DFN,SD) D Q RETURN
. D ERRX^MBAAAPIE(.RETURN,"APTCNPE",.TXT)
S RETURN=1
Q RETURN
;
CHKSPC(RETURN,DFN,SD) ; Check if status permit cancelation Called by RPC MBAA APPOINTMENT MAKE
N APT0,STATUS,IND,STAT,STATS
S RETURN=0
S APT0=$$GETAPT0^MBAAMDA2(DFN,SD)
;T13 Change to use SDAMA301 API
D STATUS^MBAARPC1(.RESULTS,DFN,SD,+APT0) S STATUS=+$G(RESULTS) ;K RESULTS
;S STATUS=+$$STATUS^SDAM1(DFN,SD,+$G(APT0),$G(APT0)) ;ICR#: 2851 MBAA ACCESS TO SDAM1 API get appointment status
D LSTCSTA1^MBAAMDA2(.STAT)
D BLDLST^MBAAMAPI(.STATS,.STAT)
S IND=0
F S IND=$O(STATS(IND)) Q:IND=""!(RETURN=1) D
. I STATS(IND,"ID")=STATUS S RETURN=1 Q
Q RETURN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMBAAMAP3 7250 printed Dec 13, 2024@02:14:50 Page 2
MBAAMAP3 ;OIT-PD/VSL - APPOINTMENT API ;02/10/2016
+1 ;;1.0;Scheduling Calendar View;**1**;Feb 13, 2015;Build 85
+2 ;
+3 ;Associated ICRs
+4 ; ICR#
+5 ;
+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 ;LSTPATS(RETURN,SEARCH,START,NUMBER) ; Get patients by name
+8 ;N RET,DL,IN,DG
+9 ;S:'$D(START) START="" S:'$D(SEARCH) SEARCH=""
+10 ;S:'$G(NUMBER) NUMBER=""
+11 ;S RETURN=0
+12 ;D GETPATS^MBAAMDA3(.RET,$$UP^XLFSTR(SEARCH),.START,NUMBER)
+13 ;S RETURN(0)=RET("DILIST",0)
+14 ;S DL="DILIST"
+15 ;F IN=1:1:$P(RETURN(0),U,1) D
+16 ;. D SENS^DGSEC4(.DG,RET(DL,2,IN),DUZ)
+17 ;. S RETURN(IN)=""
+18 ;. S RETURN(IN,"ID")=RET(DL,2,IN)
+19 ;. S RETURN(IN,"NAME")=RET(DL,"ID",IN,".01")
+20 ;. S RETURN(IN,"BIRTHDATE")=$S(DG(1)=2:"*SENSITIVE*",1:RET(DL,"ID",IN,".03"))
+21 ;. S RETURN(IN,"SSN")=$S(DG(1)=2:"*SENSITIVE*",1:RET(DL,"ID",IN,".09"))
+22 ;. S RETURN(IN,"TYPE")=RET(DL,"ID",IN,"391")
+23 ;. S RETURN(IN,"VETERAN")=RET(DL,"ID",IN,"1901")
+24 ;S RETURN=1
+25 ;Q 1
+26 ;
+27 ;GETPAT(RETURN,PATIENT,LVL) ; Get a patient
+28 ; N TEXT
+29 ; S RETURN=0 S:'$G(LVL) LVL=7
+30 ; I '$G(PATIENT) S TEXT(1)="PATIENT" D ERRX^MBAAAPIE(.RETURN,"INVPARAM",.TEXT) Q 0
+31 ; I LVL>1 D SENS^DGSEC4(.DG,PATIENT,DUZ) D ERRX^MBAAAPIE(.RETURN,"PATSENS",.TEXT) Q 0
+32 ; D GETPAT^MBAAMDA3(.RETURN,PATIENT,1,1,1)
+33 ; S RETURN=1
+34 ; Q RETURN
+35 ; ;
+36 ;LSTETNS(RETURN,SEARCH,START,NUMBER) ; Get ethnicities
+37 ; N LST
+38 ; D LSTETNS^MBAAMDA3(.LST,$G(SEARCH),.START,$G(NUMBER))
+39 ; D BLDLST^MBAAMAPI(.RETURN,.LST)
+40 ; Q RETURN
+41 ; ;
+42 ;SETETN(RETURN,PAT,ETN) ; Set patient ethnicity.
+43 ; D SETETN^MBAAMDA3(PAT,$P(ETN,U,1))
+44 ; S RETURN=1
+45 ; Q 1
+46 ; ;
+47 ;LSTRACES(RETURN,SEARCH,START,NUMBER) ; Get races
+48 ; N LST
+49 ; D LSTRACES^MBAAMDA3(.LST,$G(SEARCH),.START,$G(NUMBER))
+50 ; D BLDLST^MBAAMAPI(.RETURN,.LST)
+51 ; Q RETURN
+52 ; ;
+53 ;SETRACE(RETURN,PAT,RACE) ; Set patient race.
+54 ; D ADDRACE^MBAAMDA3(PAT,+RACE)
+55 ; S RETURN=1
+56 ; Q 1
+57 ; ;
+58 ;GETPRES(RETURN,PAT) ; Get patient races
+59 ; N LST,IND,CNT
+60 ; K RETURN
+61 ; D GETPRES^MBAAMDA3(.LST,PAT)
+62 ; S IND=0,CNT=0
+63 ; S RETURN(0)=0
+64 ; F S IND=$O(LST(2,IND)) Q:IND="" D
+65 ; . S CNT=CNT+1
+66 ; . S RETURN(CNT)="",RETURN(CNT,"ID")=IND
+67 ; . S RETURN(CNT,"NAME")=LST(2,IND,.01)
+68 ; . S RETURN(0)=CNT_"^*^0^"
+69 ; S RETURN=1
+70 ; Q 1
+71 ; ;
+72 ;Code at linetag CHKDISCH is removed until the next version/enhancment of MBAA
+73 ;CHKDISCH(RETURN,ENS,DFN,OENS) ; Check discharge
+74 ;N SC,TXT,IND,APTS,ERR,APT
+75 ;S RETURN=0,ERR=0
+76 ;S SC=$O(ENS(""))
+77 ;S TXT(1)=ENS(SC,"NAME")
+78 ;I OENS(SC,"STATUS")]"" D ERRX^MBAAAPIE(.RETURN,"PATDARD",.TXT) Q RETURN
+79 ;I '$D(OENS(SC,"EN")) D ERRX^MBAAAPIE(.RETURN,"PATDNEN",.TXT) Q RETURN
+80 ;F IND=0:0 S IND=$O(ENS(SC,"EN",IND)) Q:IND=""!(ERR>0) D
+81 ;. Q:$D(ENS(SC,"EN",IND,"DISCHARGE"))&(ENS(SC,"EN",IND,"DISCHARGE")=OENS(SC,"EN",IND,"DISCHARGE"))
+82 ;. D LSTPAPTS^MBAAMDA1(.APTS,DFN,ENS(SC,"EN",IND,"DISCHARGE"),9999999)
+83 ;. F APT=0:0 S APT=$O(APTS(APT)) Q:APT=""!(ERR>0) D
+84 ;. . I APTS(APT,"SC")=SC,$P(APTS(APT,"SDATA"),U,2)'["C",$P(APTS(APT,"SDATA"),U,2)'["N" S ERR=1
+85 ;I ERR D ERRX^MBAAAPIE(.RETURN,"PATDHFA") Q RETURN
+86 ;S RETURN=1
+87 ;Q RETURN
+88 ;
+89 ;DISCH(RETURN,ENS,DFN) ; Discharge from clinic
+90 ;N OENS,IND,SC,NENS
+91 ;S RETURN=0
+92 ;S SC=$O(ENS(""))
+93 ;S %=$$GETPENRL(.OENS,DFN,SC)
+94 ;S %=$$CHKDISCH(.RETURN,.ENS,DFN,.OENS)
+95 ;Q:RETURN=0 0
+96 ;F IND=0:0 S IND=$O(ENS(SC,"EN",IND)) Q:IND="" D
+97 ;. S:ENS(SC,"EN",IND,"DISCHARGE")'=OENS(SC,"EN",IND,"DISCHARGE") NENS(SC,"EN",IND,"DISCHARGE")=ENS(SC,"EN",IND,"DISCHARGE")
+98 ;. S:ENS(SC,"EN",IND,"REASON")'=OENS(SC,"EN",IND,"REASON") NENS(SC,"EN",IND,"REASON")=$E(ENS(SC,"EN",IND,"REASON"),1,80)
+99 ;S NENS(SC,"IEN")=ENS(SC,"IEN")
+100 ;D BEFORE^SCMCEV3(DFN)
+101 ;D UPDENRL^MBAAMDA3(.NENS,DFN)
+102 ;D AFTER^SCMCEV3(DFN)
+103 ;D INVOKE^SCMCEV3(DFN)
+104 ;S RETURN=1
+105 ;Q 1
+106 ;
+107 ;GETPENRL(RETURN,DFN,SC,STAT) ; Get patient enrollments filtered by status
+108 ; N ENS,EN,IND,CLN,SSC
+109 ; D GETCENRL^MBAAMDA3(.ENS,DFN,$G(SC))
+110 ; F SSC=0:0 S SSC=$O(ENS(SSC)) Q:SSC="" D
+111 ; . Q:$G(STAT)>0&($P(ENS(SSC,0),U,3)]"")
+112 ; . S RETURN(SSC,"STATUS")=$P(ENS(SSC,0),U,3)
+113 ; . S RETURN(SSC,"IEN")=$P(ENS(SSC,0),U,1)
+114 ; . D GETCLN^MBAAMDA1(.CLN,SSC)
+115 ; . S RETURN(SSC,"NAME")=CLN(.01)
+116 ; . F IND=0:0 S IND=$O(ENS(SSC,IND)) Q:IND="" D
+117 ; . . S EN=ENS(SSC,IND)
+118 ; . . S RETURN(SSC,"EN",IND,"ENROLLMENT")=$P(EN,U,1)
+119 ; . . S RETURN(SSC,"EN",IND,"OA")=$P(EN,U,2)
+120 ; . . S RETURN(SSC,"EN",IND,"DISCHARGE")=$P(EN,U,3)
+121 ; . . S RETURN(SSC,"EN",IND,"REASON")=$P(EN,U,4)
+122 ; . . S RETURN(SSC,"EN",IND,"REVIEW")=$P(EN,U,5)
+123 ; I $G(SC)>0 D
+124 ; . Q:$D(RETURN(SC))
+125 ; . D GETCLN^MBAAMDA1(.CLN,SC)
+126 ; . S RETURN(SC,"NAME")=CLN(.01)
+127 ; Q 1
+128 ;
CHKCIN(RETURN,DFN,SD,STATUS) ; Check in check MBAA RPC: MBAA APPOINTMENT MAKE
+1 NEW DT
+2 SET RETURN=0
+3 SET %=$$CHKSPCI(.RETURN,DFN,SD,STATUS)
if '%
QUIT 0
+4 ;ICR#: 10103 XLFDT
SET DT=$$NOW^XLFDT
+5 IF $PIECE(SD,".")>DT
DO ERRX^MBAAAPIE(.RETURN,"APTCITS")
QUIT 0
+6 QUIT 1
+7 ;
CHKSPCI(RETURN,DFN,SD,STATUS) ; Check if status permit check in MBAA RPC: MBAA APPOINTMENT MAKE
+1 NEW IND,STAT,STATS
+2 SET RETURN=0
+3 DO LSTCIST1^MBAAMDA2(.STAT)
+4 DO BLDLST^MBAAMAPI(.STATS,.STAT)
+5 SET IND=0
+6 FOR
SET IND=$ORDER(STATS(IND))
if IND=""!(RETURN=1)
QUIT
Begin DoDot:1
+7 IF STATS(IND,"ID")=STATUS
SET RETURN=1
QUIT
End DoDot:1
+8 IF 'RETURN
DO ERRX^MBAAAPIE(.RETURN,"APTCIPE")
+9 QUIT RETURN
+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 ;CHKNS(RETURN,APT0,STATUS,LVL) ; Check no-show
+12 ; N STAT
+13 ; S RETURN=1
+14 ; S %=$$CHKSPNS(.RETURN,+STATUS) Q:'% 0
+15 ; S STAT=$P(APT0,U,2)
+16 ; I STAT="I" S RETURN=0 D ERRX^MBAAAPIE(.RETURN,"APTNSIA") Q RETURN
+17 ; I LVL>1,STAT["A" S RETURN=0 D ERRX^MBAAAPIE(.RETURN,"APTNSAR",,2) Q RETURN
+18 ; I LVL>1,STAT]"",STAT'["A" S RETURN=0 D ERRX^MBAAAPIE(.RETURN,"APTNSAL",,2) Q RETURN
+19 ; Q RETURN
+20 ; ;
+21 ;CHKSPNS(RETURN,STATUS) ; Check if status of appt permits no-show
+22 ; N IND,STAT,STATS
+23 ; S RETURN=0
+24 ; D LSTNSTA1^MBAAMDA2(.STAT)
+25 ; D BLDLST^MBAAMAPI(.STATS,.STAT)
+26 ; S IND=0
+27 ; F S IND=$O(STATS(IND)) Q:IND=""!(RETURN=1) D
+28 ; . I STATS(IND,"ID")=STATUS S RETURN=1 Q
+29 ; I 'RETURN D ERRX^MBAAAPIE(.RETURN,"APTNSCE")
+30 ; Q RETURN
+31 ; ;
CHKCAN(RETURN,DFN,SC,SD) ; Verify cancel Called by RPC MBAA APPOINTMENT MAKE
+1 NEW APT,RET,%
+2 SET RETURN=0
+3 DO GETAPTS^MBAAMDA2(.APT,DFN,.SD)
+4 IF APT("APT",SD,"STATUS")["C"
Begin DoDot:1
+5 DO ERRX^MBAAAPIE(.RETURN,"APTCAND")
End DoDot:1
QUIT RETURN
+6 IF $$ISAPTCO^MBAAMAP4(,DFN,SD)
Begin DoDot:1
+7 DO ERRX^MBAAAPIE(.RETURN,"APTCCHO")
End DoDot:1
QUIT RETURN
+8 SET %=$$CLNRGHT^MBAAMAP1(.RET,+SC)
+9 IF RET=0
Begin DoDot:1
+10 SET TXT(1)=RET("CLN")
SET TXT(2)=$CHAR(10)
+11 DO ERRX^MBAAAPIE(.RETURN,"APTCRGT",.TXT)
End DoDot:1
QUIT RETURN
+12 IF '$$CHKSPC(.STAT,DFN,SD)
Begin DoDot:1
+13 DO ERRX^MBAAAPIE(.RETURN,"APTCNPE",.TXT)
End DoDot:1
QUIT RETURN
+14 SET RETURN=1
+15 QUIT RETURN
+16 ;
CHKSPC(RETURN,DFN,SD) ; Check if status permit cancelation Called by RPC MBAA APPOINTMENT MAKE
+1 NEW APT0,STATUS,IND,STAT,STATS
+2 SET RETURN=0
+3 SET APT0=$$GETAPT0^MBAAMDA2(DFN,SD)
+4 ;T13 Change to use SDAMA301 API
+5 ;K RESULTS
DO STATUS^MBAARPC1(.RESULTS,DFN,SD,+APT0)
SET STATUS=+$GET(RESULTS)
+6 ;S STATUS=+$$STATUS^SDAM1(DFN,SD,+$G(APT0),$G(APT0)) ;ICR#: 2851 MBAA ACCESS TO SDAM1 API get appointment status
+7 DO LSTCSTA1^MBAAMDA2(.STAT)
+8 DO BLDLST^MBAAMAPI(.STATS,.STAT)
+9 SET IND=0
+10 FOR
SET IND=$ORDER(STATS(IND))
if IND=""!(RETURN=1)
QUIT
Begin DoDot:1
+11 IF STATS(IND,"ID")=STATUS
SET RETURN=1
QUIT
End DoDot:1
+12 QUIT RETURN
+13 ;
