MBAAMAP4 ;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
;CHECKO(RETURN,DFN,SD,SC) ; Check out
;N CAPT,OE,APT0,CD,%
;S RETURN=0
;S %=$$GETSCAP^MBAAMAP1(.CAPT,SC,DFN,SD)
;I '$D(CAPT) D ERRX^MBAAAPIE(.RETURN,"APTCOCN") Q 0
;S APT0=$$GETAPT0^MBAAMDA2(DFN,SD)
;S STATUS=$$STATUS^SDAM1(DFN,SD,+$G(APT0),$G(APT0))
;K % S %=$$CHKCO(.RETURN,DFN,SD,+STATUS)
;Q:'RETURN 0
;I '$$NEW^SDPCE(SD) D ERRX^MBAAAPIE(.RETURN,"APTCONW",,2)
;S CD(304)=DUZ,CD(303)=$E($$NOW^XLFDT(),1,12)
;D UPDCAPT^MBAAMDA4(.CD,SC,SD,CAPT("IFN"))
;S RETURN("SDOE")=$$GETAPT(DFN,SD,SC)
;S RETURN("COD")=CAPT("CHECKOUT")
;S OE(.04)="",OE(.05)=""
;D GETOE^MBAAMDA4(.OE,RETURN("SDOE"))
;S RETURN("LOCATION")=OE(.04)
;S RETURN("VISIT")=OE(.05)
;S RETURN("COVISIT")=$P(APT0,U,11)
;I "^2^8^12^"[("^"_+STATUS_"^"),$P(STATUS,";",3)["CHECKED OUT" D
;. S RETURN("CO")=1 S RETURN=0
;. D ERRX^MBAAAPIE(.RETURN,"APTCOAC",,2)
;Q 1
;
;GETAPT(DFN,SDT,SDCL,SDVIEN) ;Look-up Outpatient Encounter IEN for Appt
; Input -- DFN Patient file IEN
; SDT Appointment Date/Time
; SDCL Hospital Location file IEN for Appt
; SDVIEN Visit file pointer [optional]
; Output -- Outpatient Encounter file IEN
;N PAPT
;S PAPT(21)=""
;D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
;I 'PAPT(21) D APPT^SDVSIT(DFN,SDT,SDCL,$G(SDVIEN)) D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
;I PAPT(21) D VIEN^SDVSIT2(PAPT(21),$G(SDVIEN))
;Q +$G(PAPT(21))
;
;CHKCO(RETURN,DFN,SD,STATUS) ; Check in check out
;S RETURN=0
;I '$D(STATUS) D
;. S APT0=$$GETAPT0^MBAAMDA2(DFN,SD)
;. S STATUS=$$STATUS^SDAM1(DFN,SD,+$G(APT0),$G(APT0))
;S %=$$CHKSPCO(.RETURN,DFN,SD,+STATUS) Q:'% 0
;S DT=$$NOW^XLFDT
;I $P(SD,".")>DT D ERRX^MBAAAPIE(.RETURN,"APTCOTS") Q 0
;Q 1
;
;CHKSPCO(RETURN,DFN,SD,STATUS) ; Check if status permit check in
;N IND,STAT,STATS
;S RETURN=0
;D LSTCOST1^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,"APTCOCE")
;Q RETURN
;
;CHKDCO(RETURN,DFN,SD) ; Check delete check out
;N PAPT,CAPT,OE,SDATA,SDELHDL,X,%
;S PAPT(21)="",PAPT(.01)=""
;S OE(.01)="",OE(.04)="",OE(.05)="",OE(.08)="",OE(.09)="",OE(.06)=""
;D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
;S %=$$GETSCAP^MBAAMAP1(.CAPT,PAPT(.01),DFN,SD)
;D GETOE^MBAAMDA4(.OE,PAPT(21))
;S RETURN=0
;I 'PAPT(21)!('CAPT("CHECKOUT")) D ERRX^MBAAAPIE(.RETURN,"APTDCOD") Q 0
;I '$$NEW^SDPCE(OE(.01)) D ERRX^MBAAAPIE(.RETURN,"APTDCOO") Q 0
;S RETURN=1
;Q 1
;
;DELCOPC(RETURN,SDOE,SDELHDL,SDELSRC) ; Delete check out (PCE)
;N SC,OE,SDDA,SDEVTF,X
;D SETCO(.SDOE,.DFN,.SD,.OE,.SC,.SDDA)
;I $G(SDELSRC)'="PCE" S X=$$DELVFILE^PXAPI("ALL",OE(.05),"","","")
;I '$$NEW^SDPCE(SD) D ERRX^MBAAAPIE(.RETURN,"APTDCOO") Q 0
;I '$G(SDELHDL) N SDATA,SDELHDL S SDEVTF=1 D EVT^SDCOU1(SDOE,"BEFORE",.SDELHDL,.SDATA)
;S %=$$DELCOL(.RETURN,DFN,SD,SC,SDDA,SDOE,.OE)
;I $G(SDEVTF) D EVT^SDCOU1(SDOE,"AFTER",.SDELHDL,.SDATA)
;S RETURN=1
;Q 1
;
;DELCO(RETURN,DFN,SD) ;Delete check-out (SD) silent version
;N TXT
;K RETURN
;S RETURN=0
;I +$G(DFN)'>0 S TXT(1)="DFN" D ERRX^MBAAAPIE(.RETURN,"INVPARAM",.TXT) Q 0
;I +$G(SD)'>0 S TXT(1)="SD" D ERRX^MBAAAPIE(.RETURN,"INVPARAM",.TXT) Q 0
;Q $$DELCOSD(.RETURN,DFN,SD)
;
;DELCOSD(RETURN,DFN,SD,ECHO) ; Delete check out (SD)
;N %
;S %=$$CHKDCO(.RETURN,DFN,SD)
;I RETURN=0 Q 0
;N SDOE,SC,OE,SDDA,X
;D SETCO(.SDOE,.DFN,.SD,.OE,.SC,.SDDA)
;I '$$NEW^SDPCE(SD) D ERRX^MBAAAPIE(.RETURN,"APTDCOO") Q 0
;S SDELHDL=$$HANDLE^SDAMEVT(1)
;S X=$$DELVFILE^PXAPI("ALL",OE(.05),"","","",.ECHO)
;S %=$$DELCOL(.RETURN,DFN,SD,SC,SDDA,SDOE,.OE)
;S SDOE=$$GETAPT(DFN,SD,SC)
;S RETURN("OE")=SDOE
;Q 1
;
;SETCO(SDOE,DFN,SD,OE,SC,SDDA) ; Set Check out params
;N PAPT,CAPT,%
;I '$D(SDOE) D
;. S PAPT(21)="",PAPT(.01)=""
;. D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
;. S SDOE=PAPT(21),SC=PAPT(.01)
;S OE(.01)="",OE(.02)="",OE(.04)="",OE(.05)="",OE(.08)="",OE(.09)="",OE(.06)=""
;D GETOE^MBAAMDA4(.OE,SDOE)
;S DFN=OE(.02),SD=OE(.01),SC=OE(.04)
;S %=$$GETSCAP^MBAAMAP1(.CAPT,SC,DFN,SD)
;S SDDA=CAPT("IFN")
;Q
;
;DELCOL(RETURN,DFN,SD,SC,SDDA,SDOE,OE) ; Delete check out
;N SDATA,SDELHDL,SDORG,VSIT
;S SDORG=OE(.08),VSIT=OE(.05)
;I "^1^2^3^"[("^"_SDORG_"^") D DELCHLD(SDOE)
;N PDATA
;I SDORG=1 D
;. S PDATA(21)="@"
;. N CDATA S CDATA(303)="@"
;. D UPDCAPT^MBAAMDA4(.CDATA,SC,SD,SDDA)
;I SDORG=3 D
;. S PDATA(18)="@"
;D UPDPAPT^MBAAMDA4(.PDATA,DFN,SD)
;D DELCLS^MBAAMDA4(SDOE)
;D DELOE(SDOE,.OE)
; -- call pce to make sure its data is gone
;D DEAD^PXUTLSTP(VSIT)
;Q 1
;
;DELOE(SDOE,OE) ; Delete Outpatient Encounter
;I '$D(OE) D
;. S OE(.05)="",OE(.01)="",OE(.08)=""
;. D GETOE^MBAAMDA4(.OE,SDOE)
;I '$$NEW^SDPCE(OE(.01)) Q
;D DELOE^MBAAMDA4(SDOE)
;S X=$$KILL^VSITKIL(OE(.05))
;Q
;
;DELCHLD(SDOEP) ;Delete Children
;N SDOEC,CHLD
;S SDOEC=0
;D GETCHLD^MBAAMDA4(.CHLD,SDOEP)
;F S SDOEC=$O(CHLD(SDOEC)) Q:'SDOEC D
;. D DELOE(SDOEC)
;Q
;
;LSTDAYAP(RETURN,DFN) ; List all day active appointment
; N DAP,PAP,CAP,PFLDS,CFLDS,AP,FLD,NM,PNMS,CNMS,TXT
; I '$D(DT) S DT=$P($$NOW^XLFDT(),".")
; I '$D(DFN)!(+$G(DFN)'>0) S RETURN=0,TXT(1)="DFN" D ERRX^MBAAAPIE(.RETURN,"INVPARAM",.TXT)
; S PFLDS=".01;3",CFLDS=".01;222;333"
; S PNMS="CLINIC;STATUS",CNMS="PATIENT;CIFN;IFN"
; D GETDAPTS^MBAAMDA2(.DAP,+DFN,$P(DT,"."))
; S AP=0
; F S AP=$O(DAP(AP)) Q:AP="" D
; . I DAP(AP,2)["C"!(DAP(AP,2)["N")!(DAP(AP,2)="NT") Q
; . D GETPAPT^MBAAMDA4(.PAP,+DFN,AP,PFLDS)
; . F FLD=0:0 S FLD=$O(PAP(FLD)) Q:'FLD D
; . . S NM=$$FLDNAME^MBAAMUTL(PFLDS,PNMS,FLD)
; . . S RETURN(AP,NM)=PAP(FLD,"I")_U_PAP(FLD,"E")
; . D GETCAPT^MBAAMDA4(.CAP,+DFN,AP,CFLDS)
; . F FLD=0:0 S FLD=$O(CAP(FLD)) Q:'FLD D
; . . S NM=$$FLDNAME^MBAAMUTL(CFLDS,CNMS,FLD)
; . . S RETURN(AP,"C",NM)=CAP(FLD)
; Q 1
; ;
;GETPAPT(RETURN,DFN,SD) ; Get patient appointment
; N IND,NAME,FLDS,NAMES,APT
; S FLDS=".01;3;5;6;7;9;12;13;14;15;16;9.5;17;19;20;21;25;26;27;28"
; S NAMES="CLINIC;STATUS;LABDT;XRAYDT;EKGDT;PURPOSE;ARBK;CVISIT;NOSHOWBY;NOSHOWDT;"
; S NAMES=NAMES_"CREASON;TYPE;CREMARKS;ENTRY;MADEDT;OE;RTYPE;NEXTA;DDATE;FVISIT"
; D GETPAPT^MBAAMDA4(.APT,DFN,SD)
; F IND=0:0 S IND=$O(APT(IND)) Q:IND="" D
; . S NAME=$$FLDNAME^MBAAMUTL(FLDS,NAMES,IND)
; . S RETURN(NAME)=APT(IND,"E")
; . S RETURN(NAME,"I")=APT(IND,"I")
; S RETURN=1
; Q 1
; ;
;GETCAPT(RETURN,DFN,SD) ; Get clinic appointment
; N IND,NAME,FLDS,NAMES,CAPT
; S FLDS=".01;1;3;7;8;9;30;309;302;303;304;306;222;333"
; S NAMES="PATIENT;LENGTH;OTHER;ENTRY;MADEDT;OVERBOOK;EVISIT;CIDT;"
; S NAMES=NAMES_"CIUSER;CODT;COUSER;COENTER;222;333"
; D GETCAPT^MBAAMDA4(.CAPT,DFN,SD)
; F IND=0:0 S IND=$O(CAPT(IND)) Q:IND="" D
; . S NAME=$$FLDNAME^MBAAMUTL(FLDS,NAMES,IND) Q:NAME=""
; . S RETURN(NAME)=CAPT(IND)
; S RETURN("STATUS")=$$STATUS^SDAM1(DFN,SD,CAPT(222),CAPT(333))
; S RETURN=1
; Q 1
; ;
;GETOE(RETURN,SDOE) ; Get outpatient encounter
; K RETURN
; S RETURN(.07)="",RETURN(.08)="",RETURN(.01)="",RETURN(.02)=""
; S RETURN(.03)="",RETURN(.04)="",RETURN(.05)=""
; D GETOE^MBAAMDA4(.RETURN,SDOE)
; Q:'$D(RETURN) 0
; S RETURN("DATE")=RETURN(.01)
; S RETURN("PATIENT")=RETURN(.02)
; S RETURN("SCODE")=RETURN(.03)
; S RETURN("CLINIC")=RETURN(.04)
; S RETURN("VISIT")=RETURN(.05)
; Q 1
;
;GETPAT(RETURN,DFN) ; Get patient
;N IND,NAME,FLDS,NAMES,PAT
;S RETURN=0
;S FLDS=".01;.02;.03;.05;.08;.361;.323;.131;.111;.134;.112;.135;.1173;.1112;"
;S FLDS=FLDS_".114;.115;.1172;.1171;.133;.32103;.525;.32102;.3213;.32115;.322013"
;S NAMES="PATIENT;SEX;BIRTH;MSTATUS;RELIG;PELIG;PSERV;PHONE;ADD1;"
;S NAMES=NAMES_"CELL;ADD2;PAGER;COUNTRY;ZIP;CITY;STATE;PCODE;PROVINCE;"
;S NAMES=NAMES_"EMAIL;EXPOI;POWSTAT;AGENTO;AGENTOL;PROJ;SASIA"
;D GETPAT^MBAAMDA4(.PAT,DFN)
;F IND=0:0 S IND=$O(PAT(IND)) Q:IND="" D
;. S NAME=$$FLDNAME^MBAAMUTL(FLDS,NAMES,IND) Q:NAME=""
;. S RETURN(NAME)=PAT(IND,"E")
;. S RETURN(NAME,"I")=PAT(IND,"I")
;S RETURN=1
;Q 1
;
;GETCHLD(RETURN,SDOE) ; Get children encounters
; D GETCHLD^MBAAMDA4(.RETURN,SDOE)
; S RETURN=1
; Q 1
;
DOW(SD) ; Called by RPC MBAA APPOINTMENT MAKE
N Y
S %=$E(SD,1,3),Y=$E(SD,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)
F %=%:-1:281 S Y=%#4=1+1+Y
S Y=$E(SD,6,7)+Y#7
Q Y
;
SETST(RETURN,SC,SD) ; Called by RPC MBAA APPOINTMENT MAKE
N SDD,ST,PATT,CLN,DATA,SI,DOW
S SDD=$P(SD,".",1)
S ST=$$GETDST^MBAAMDA1(SC,SDD)
S RETURN=0
I $G(ST)']"" D Q:RETURN=0 0
. S DOW=$$DOW(SD)
. D GETDPATT^MBAAMDA1(.PATT,SC,SDD,DOW)
. I PATT("IEN")'>0!($G(PATT("PAT"))="") D ERRX^MBAAAPIE(.RETURN,"APTWHEN") Q
. S ST=PATT("PAT")
. S CLN(1917)=""
. D GETCLNX^MBAAMDA1(.CLN,SC)
. S SI=CLN(1917),SI=$S(SI="":4,SI<3:4,SI:SI,1:4)
. S ST=$E($P($T(DAY),U,DOW+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_ST
. S DATA(.01)=SDD,DATA(1)=ST
. D ADDPATT^MBAAMDA1(.DATA,SC,SDD)
. S RETURN=1
S RETURN=1
Q 1
DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
;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
;CANDELCO(RETURN) ; Check if user can delete check out data
; N KEYS,SUP K RETURN
; S KEYS("SD SUPERVISOR")=""
; D GETXUS^MBAAMDA3(.SUP,.KEYS,DUZ)
; I '$D(SUP("SD SUPERVISOR")) S RETURN=0 D ERRX^MBAAAPIE(.RETURN,"APTCOSU") Q 0
; S RETURN=1
; Q 1
;
;DELCODT(RETURN,SDOE) ;Delete Check Out Process Completion Date
; D DELCODT^MBAAMDA4(.RETURN,SDOE)
; S RETURN=1
; Q 1
;
;ADDTSTS(RETURN,DFN,SD,LAB,XRAY,EKG) ; Append tests to pending appointment
; N DATA,ERR
; K RETURN
; S %=$$ISOECO^MBAAMAP4(.ERR,DFN,SD,"add")
; I ERR=1 M RETURN=ERR S RETURN=0 Q 0
; S:$D(LAB) DATA(5)=LAB
; S:$D(XRAY) DATA(6)=XRAY
; S:$D(EKG) DATA(7)=EKG
; D UPDPAPT^MBAAMDA4(.DATA,DFN,SD)
; S RETURN=1
; Q 1
;
;DELTSTS(RETURN,DFN,SD,LAB,XRAY,EKG) ; Delete tests from pending appointment
; N DATA,ERR
; K RETURN
; S %=$$ISOECO^MBAAMAP4(.ERR,DFN,SD,"delete")
; I ERR=1 M RETURN=ERR S RETURN=0 Q 0
; S:$D(LAB) DATA(5)="@"
; S:$D(XRAY) DATA(6)="@"
; S:$D(EKG) DATA(7)="@"
; D UPDPAPT^MBAAMDA4(.DATA,DFN,SD)
; S RETURN=1
; Q 1
;
ISAPTCO(RETURN,DFN,SD) ; Is appointment checked out? Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
N APT,FLDS
S FLDS="303"
D GETCAPT^MBAAMDA4(.APT,+DFN,+SD,.FLDS,"I")
S RETURN=1
Q $G(APT(303,"I"))>0
;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
;ISOECO(RETURN,DFN,SD,OP) ; Is outpatient encounter checked out?
;N OE,APT,FLDS,PARAM
;S RETURN=0,DFN=+DFN,PARAM(1)=OP
;S OE(.12)="",FLDS="21"
;D GETPAPT^MBAAMDA4(.APT,+DFN,+SD,.FLDS)
;I $G(APT(21,"I"))="" Q 1
;D GETOE^MBAAMDA4(.OE,APT(21,"I"))
;I OE(.12)=2 D BLD^DIALOG(480000.03,.OP,,"RETURN","FS") S RETURN=1
;Q 1
;
GETHOL(RETURN,SD) ; Get holiday MBAA RPC: MBAA APPOINTMENT MAKE
D GETHOL^MBAAMDA1(.RETURN,SD)
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMBAAMAP4 11345 printed Dec 13, 2024@02:14:51 Page 2
MBAAMAP4 ;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 ;CHECKO(RETURN,DFN,SD,SC) ; Check out
+8 ;N CAPT,OE,APT0,CD,%
+9 ;S RETURN=0
+10 ;S %=$$GETSCAP^MBAAMAP1(.CAPT,SC,DFN,SD)
+11 ;I '$D(CAPT) D ERRX^MBAAAPIE(.RETURN,"APTCOCN") Q 0
+12 ;S APT0=$$GETAPT0^MBAAMDA2(DFN,SD)
+13 ;S STATUS=$$STATUS^SDAM1(DFN,SD,+$G(APT0),$G(APT0))
+14 ;K % S %=$$CHKCO(.RETURN,DFN,SD,+STATUS)
+15 ;Q:'RETURN 0
+16 ;I '$$NEW^SDPCE(SD) D ERRX^MBAAAPIE(.RETURN,"APTCONW",,2)
+17 ;S CD(304)=DUZ,CD(303)=$E($$NOW^XLFDT(),1,12)
+18 ;D UPDCAPT^MBAAMDA4(.CD,SC,SD,CAPT("IFN"))
+19 ;S RETURN("SDOE")=$$GETAPT(DFN,SD,SC)
+20 ;S RETURN("COD")=CAPT("CHECKOUT")
+21 ;S OE(.04)="",OE(.05)=""
+22 ;D GETOE^MBAAMDA4(.OE,RETURN("SDOE"))
+23 ;S RETURN("LOCATION")=OE(.04)
+24 ;S RETURN("VISIT")=OE(.05)
+25 ;S RETURN("COVISIT")=$P(APT0,U,11)
+26 ;I "^2^8^12^"[("^"_+STATUS_"^"),$P(STATUS,";",3)["CHECKED OUT" D
+27 ;. S RETURN("CO")=1 S RETURN=0
+28 ;. D ERRX^MBAAAPIE(.RETURN,"APTCOAC",,2)
+29 ;Q 1
+30 ;
+31 ;GETAPT(DFN,SDT,SDCL,SDVIEN) ;Look-up Outpatient Encounter IEN for Appt
+32 ; Input -- DFN Patient file IEN
+33 ; SDT Appointment Date/Time
+34 ; SDCL Hospital Location file IEN for Appt
+35 ; SDVIEN Visit file pointer [optional]
+36 ; Output -- Outpatient Encounter file IEN
+37 ;N PAPT
+38 ;S PAPT(21)=""
+39 ;D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
+40 ;I 'PAPT(21) D APPT^SDVSIT(DFN,SDT,SDCL,$G(SDVIEN)) D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
+41 ;I PAPT(21) D VIEN^SDVSIT2(PAPT(21),$G(SDVIEN))
+42 ;Q +$G(PAPT(21))
+43 ;
+44 ;CHKCO(RETURN,DFN,SD,STATUS) ; Check in check out
+45 ;S RETURN=0
+46 ;I '$D(STATUS) D
+47 ;. S APT0=$$GETAPT0^MBAAMDA2(DFN,SD)
+48 ;. S STATUS=$$STATUS^SDAM1(DFN,SD,+$G(APT0),$G(APT0))
+49 ;S %=$$CHKSPCO(.RETURN,DFN,SD,+STATUS) Q:'% 0
+50 ;S DT=$$NOW^XLFDT
+51 ;I $P(SD,".")>DT D ERRX^MBAAAPIE(.RETURN,"APTCOTS") Q 0
+52 ;Q 1
+53 ;
+54 ;CHKSPCO(RETURN,DFN,SD,STATUS) ; Check if status permit check in
+55 ;N IND,STAT,STATS
+56 ;S RETURN=0
+57 ;D LSTCOST1^MBAAMDA2(.STAT)
+58 ;D BLDLST^MBAAMAPI(.STATS,.STAT)
+59 ;S IND=0
+60 ;F S IND=$O(STATS(IND)) Q:IND=""!(RETURN=1) D
+61 ;. I STATS(IND,"ID")=STATUS S RETURN=1 Q
+62 ;I 'RETURN D ERRX^MBAAAPIE(.RETURN,"APTCOCE")
+63 ;Q RETURN
+64 ;
+65 ;CHKDCO(RETURN,DFN,SD) ; Check delete check out
+66 ;N PAPT,CAPT,OE,SDATA,SDELHDL,X,%
+67 ;S PAPT(21)="",PAPT(.01)=""
+68 ;S OE(.01)="",OE(.04)="",OE(.05)="",OE(.08)="",OE(.09)="",OE(.06)=""
+69 ;D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
+70 ;S %=$$GETSCAP^MBAAMAP1(.CAPT,PAPT(.01),DFN,SD)
+71 ;D GETOE^MBAAMDA4(.OE,PAPT(21))
+72 ;S RETURN=0
+73 ;I 'PAPT(21)!('CAPT("CHECKOUT")) D ERRX^MBAAAPIE(.RETURN,"APTDCOD") Q 0
+74 ;I '$$NEW^SDPCE(OE(.01)) D ERRX^MBAAAPIE(.RETURN,"APTDCOO") Q 0
+75 ;S RETURN=1
+76 ;Q 1
+77 ;
+78 ;DELCOPC(RETURN,SDOE,SDELHDL,SDELSRC) ; Delete check out (PCE)
+79 ;N SC,OE,SDDA,SDEVTF,X
+80 ;D SETCO(.SDOE,.DFN,.SD,.OE,.SC,.SDDA)
+81 ;I $G(SDELSRC)'="PCE" S X=$$DELVFILE^PXAPI("ALL",OE(.05),"","","")
+82 ;I '$$NEW^SDPCE(SD) D ERRX^MBAAAPIE(.RETURN,"APTDCOO") Q 0
+83 ;I '$G(SDELHDL) N SDATA,SDELHDL S SDEVTF=1 D EVT^SDCOU1(SDOE,"BEFORE",.SDELHDL,.SDATA)
+84 ;S %=$$DELCOL(.RETURN,DFN,SD,SC,SDDA,SDOE,.OE)
+85 ;I $G(SDEVTF) D EVT^SDCOU1(SDOE,"AFTER",.SDELHDL,.SDATA)
+86 ;S RETURN=1
+87 ;Q 1
+88 ;
+89 ;DELCO(RETURN,DFN,SD) ;Delete check-out (SD) silent version
+90 ;N TXT
+91 ;K RETURN
+92 ;S RETURN=0
+93 ;I +$G(DFN)'>0 S TXT(1)="DFN" D ERRX^MBAAAPIE(.RETURN,"INVPARAM",.TXT) Q 0
+94 ;I +$G(SD)'>0 S TXT(1)="SD" D ERRX^MBAAAPIE(.RETURN,"INVPARAM",.TXT) Q 0
+95 ;Q $$DELCOSD(.RETURN,DFN,SD)
+96 ;
+97 ;DELCOSD(RETURN,DFN,SD,ECHO) ; Delete check out (SD)
+98 ;N %
+99 ;S %=$$CHKDCO(.RETURN,DFN,SD)
+100 ;I RETURN=0 Q 0
+101 ;N SDOE,SC,OE,SDDA,X
+102 ;D SETCO(.SDOE,.DFN,.SD,.OE,.SC,.SDDA)
+103 ;I '$$NEW^SDPCE(SD) D ERRX^MBAAAPIE(.RETURN,"APTDCOO") Q 0
+104 ;S SDELHDL=$$HANDLE^SDAMEVT(1)
+105 ;S X=$$DELVFILE^PXAPI("ALL",OE(.05),"","","",.ECHO)
+106 ;S %=$$DELCOL(.RETURN,DFN,SD,SC,SDDA,SDOE,.OE)
+107 ;S SDOE=$$GETAPT(DFN,SD,SC)
+108 ;S RETURN("OE")=SDOE
+109 ;Q 1
+110 ;
+111 ;SETCO(SDOE,DFN,SD,OE,SC,SDDA) ; Set Check out params
+112 ;N PAPT,CAPT,%
+113 ;I '$D(SDOE) D
+114 ;. S PAPT(21)="",PAPT(.01)=""
+115 ;. D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
+116 ;. S SDOE=PAPT(21),SC=PAPT(.01)
+117 ;S OE(.01)="",OE(.02)="",OE(.04)="",OE(.05)="",OE(.08)="",OE(.09)="",OE(.06)=""
+118 ;D GETOE^MBAAMDA4(.OE,SDOE)
+119 ;S DFN=OE(.02),SD=OE(.01),SC=OE(.04)
+120 ;S %=$$GETSCAP^MBAAMAP1(.CAPT,SC,DFN,SD)
+121 ;S SDDA=CAPT("IFN")
+122 ;Q
+123 ;
+124 ;DELCOL(RETURN,DFN,SD,SC,SDDA,SDOE,OE) ; Delete check out
+125 ;N SDATA,SDELHDL,SDORG,VSIT
+126 ;S SDORG=OE(.08),VSIT=OE(.05)
+127 ;I "^1^2^3^"[("^"_SDORG_"^") D DELCHLD(SDOE)
+128 ;N PDATA
+129 ;I SDORG=1 D
+130 ;. S PDATA(21)="@"
+131 ;. N CDATA S CDATA(303)="@"
+132 ;. D UPDCAPT^MBAAMDA4(.CDATA,SC,SD,SDDA)
+133 ;I SDORG=3 D
+134 ;. S PDATA(18)="@"
+135 ;D UPDPAPT^MBAAMDA4(.PDATA,DFN,SD)
+136 ;D DELCLS^MBAAMDA4(SDOE)
+137 ;D DELOE(SDOE,.OE)
+138 ; -- call pce to make sure its data is gone
+139 ;D DEAD^PXUTLSTP(VSIT)
+140 ;Q 1
+141 ;
+142 ;DELOE(SDOE,OE) ; Delete Outpatient Encounter
+143 ;I '$D(OE) D
+144 ;. S OE(.05)="",OE(.01)="",OE(.08)=""
+145 ;. D GETOE^MBAAMDA4(.OE,SDOE)
+146 ;I '$$NEW^SDPCE(OE(.01)) Q
+147 ;D DELOE^MBAAMDA4(SDOE)
+148 ;S X=$$KILL^VSITKIL(OE(.05))
+149 ;Q
+150 ;
+151 ;DELCHLD(SDOEP) ;Delete Children
+152 ;N SDOEC,CHLD
+153 ;S SDOEC=0
+154 ;D GETCHLD^MBAAMDA4(.CHLD,SDOEP)
+155 ;F S SDOEC=$O(CHLD(SDOEC)) Q:'SDOEC D
+156 ;. D DELOE(SDOEC)
+157 ;Q
+158 ;
+159 ;LSTDAYAP(RETURN,DFN) ; List all day active appointment
+160 ; N DAP,PAP,CAP,PFLDS,CFLDS,AP,FLD,NM,PNMS,CNMS,TXT
+161 ; I '$D(DT) S DT=$P($$NOW^XLFDT(),".")
+162 ; I '$D(DFN)!(+$G(DFN)'>0) S RETURN=0,TXT(1)="DFN" D ERRX^MBAAAPIE(.RETURN,"INVPARAM",.TXT)
+163 ; S PFLDS=".01;3",CFLDS=".01;222;333"
+164 ; S PNMS="CLINIC;STATUS",CNMS="PATIENT;CIFN;IFN"
+165 ; D GETDAPTS^MBAAMDA2(.DAP,+DFN,$P(DT,"."))
+166 ; S AP=0
+167 ; F S AP=$O(DAP(AP)) Q:AP="" D
+168 ; . I DAP(AP,2)["C"!(DAP(AP,2)["N")!(DAP(AP,2)="NT") Q
+169 ; . D GETPAPT^MBAAMDA4(.PAP,+DFN,AP,PFLDS)
+170 ; . F FLD=0:0 S FLD=$O(PAP(FLD)) Q:'FLD D
+171 ; . . S NM=$$FLDNAME^MBAAMUTL(PFLDS,PNMS,FLD)
+172 ; . . S RETURN(AP,NM)=PAP(FLD,"I")_U_PAP(FLD,"E")
+173 ; . D GETCAPT^MBAAMDA4(.CAP,+DFN,AP,CFLDS)
+174 ; . F FLD=0:0 S FLD=$O(CAP(FLD)) Q:'FLD D
+175 ; . . S NM=$$FLDNAME^MBAAMUTL(CFLDS,CNMS,FLD)
+176 ; . . S RETURN(AP,"C",NM)=CAP(FLD)
+177 ; Q 1
+178 ; ;
+179 ;GETPAPT(RETURN,DFN,SD) ; Get patient appointment
+180 ; N IND,NAME,FLDS,NAMES,APT
+181 ; S FLDS=".01;3;5;6;7;9;12;13;14;15;16;9.5;17;19;20;21;25;26;27;28"
+182 ; S NAMES="CLINIC;STATUS;LABDT;XRAYDT;EKGDT;PURPOSE;ARBK;CVISIT;NOSHOWBY;NOSHOWDT;"
+183 ; S NAMES=NAMES_"CREASON;TYPE;CREMARKS;ENTRY;MADEDT;OE;RTYPE;NEXTA;DDATE;FVISIT"
+184 ; D GETPAPT^MBAAMDA4(.APT,DFN,SD)
+185 ; F IND=0:0 S IND=$O(APT(IND)) Q:IND="" D
+186 ; . S NAME=$$FLDNAME^MBAAMUTL(FLDS,NAMES,IND)
+187 ; . S RETURN(NAME)=APT(IND,"E")
+188 ; . S RETURN(NAME,"I")=APT(IND,"I")
+189 ; S RETURN=1
+190 ; Q 1
+191 ; ;
+192 ;GETCAPT(RETURN,DFN,SD) ; Get clinic appointment
+193 ; N IND,NAME,FLDS,NAMES,CAPT
+194 ; S FLDS=".01;1;3;7;8;9;30;309;302;303;304;306;222;333"
+195 ; S NAMES="PATIENT;LENGTH;OTHER;ENTRY;MADEDT;OVERBOOK;EVISIT;CIDT;"
+196 ; S NAMES=NAMES_"CIUSER;CODT;COUSER;COENTER;222;333"
+197 ; D GETCAPT^MBAAMDA4(.CAPT,DFN,SD)
+198 ; F IND=0:0 S IND=$O(CAPT(IND)) Q:IND="" D
+199 ; . S NAME=$$FLDNAME^MBAAMUTL(FLDS,NAMES,IND) Q:NAME=""
+200 ; . S RETURN(NAME)=CAPT(IND)
+201 ; S RETURN("STATUS")=$$STATUS^SDAM1(DFN,SD,CAPT(222),CAPT(333))
+202 ; S RETURN=1
+203 ; Q 1
+204 ; ;
+205 ;GETOE(RETURN,SDOE) ; Get outpatient encounter
+206 ; K RETURN
+207 ; S RETURN(.07)="",RETURN(.08)="",RETURN(.01)="",RETURN(.02)=""
+208 ; S RETURN(.03)="",RETURN(.04)="",RETURN(.05)=""
+209 ; D GETOE^MBAAMDA4(.RETURN,SDOE)
+210 ; Q:'$D(RETURN) 0
+211 ; S RETURN("DATE")=RETURN(.01)
+212 ; S RETURN("PATIENT")=RETURN(.02)
+213 ; S RETURN("SCODE")=RETURN(.03)
+214 ; S RETURN("CLINIC")=RETURN(.04)
+215 ; S RETURN("VISIT")=RETURN(.05)
+216 ; Q 1
+217 ;
+218 ;GETPAT(RETURN,DFN) ; Get patient
+219 ;N IND,NAME,FLDS,NAMES,PAT
+220 ;S RETURN=0
+221 ;S FLDS=".01;.02;.03;.05;.08;.361;.323;.131;.111;.134;.112;.135;.1173;.1112;"
+222 ;S FLDS=FLDS_".114;.115;.1172;.1171;.133;.32103;.525;.32102;.3213;.32115;.322013"
+223 ;S NAMES="PATIENT;SEX;BIRTH;MSTATUS;RELIG;PELIG;PSERV;PHONE;ADD1;"
+224 ;S NAMES=NAMES_"CELL;ADD2;PAGER;COUNTRY;ZIP;CITY;STATE;PCODE;PROVINCE;"
+225 ;S NAMES=NAMES_"EMAIL;EXPOI;POWSTAT;AGENTO;AGENTOL;PROJ;SASIA"
+226 ;D GETPAT^MBAAMDA4(.PAT,DFN)
+227 ;F IND=0:0 S IND=$O(PAT(IND)) Q:IND="" D
+228 ;. S NAME=$$FLDNAME^MBAAMUTL(FLDS,NAMES,IND) Q:NAME=""
+229 ;. S RETURN(NAME)=PAT(IND,"E")
+230 ;. S RETURN(NAME,"I")=PAT(IND,"I")
+231 ;S RETURN=1
+232 ;Q 1
+233 ;
+234 ;GETCHLD(RETURN,SDOE) ; Get children encounters
+235 ; D GETCHLD^MBAAMDA4(.RETURN,SDOE)
+236 ; S RETURN=1
+237 ; Q 1
+238 ;
DOW(SD) ; Called by RPC MBAA APPOINTMENT MAKE
+1 NEW Y
+2 SET %=$EXTRACT(SD,1,3)
SET Y=$EXTRACT(SD,4,5)
SET Y=Y>2&'(%#4)+$EXTRACT("144025036146",Y)
+3 FOR %=%:-1:281
SET Y=%#4=1+1+Y
+4 SET Y=$EXTRACT(SD,6,7)+Y#7
+5 QUIT Y
+6 ;
SETST(RETURN,SC,SD) ; Called by RPC MBAA APPOINTMENT MAKE
+1 NEW SDD,ST,PATT,CLN,DATA,SI,DOW
+2 SET SDD=$PIECE(SD,".",1)
+3 SET ST=$$GETDST^MBAAMDA1(SC,SDD)
+4 SET RETURN=0
+5 IF $GET(ST)']""
Begin DoDot:1
+6 SET DOW=$$DOW(SD)
+7 DO GETDPATT^MBAAMDA1(.PATT,SC,SDD,DOW)
+8 IF PATT("IEN")'>0!($GET(PATT("PAT"))="")
DO ERRX^MBAAAPIE(.RETURN,"APTWHEN")
QUIT
+9 SET ST=PATT("PAT")
+10 SET CLN(1917)=""
+11 DO GETCLNX^MBAAMDA1(.CLN,SC)
+12 SET SI=CLN(1917)
SET SI=$SELECT(SI="":4,SI<3:4,SI:SI,1:4)
+13 SET ST=$EXTRACT($PIECE($TEXT(DAY),U,DOW+2),1,2)_" "_$EXTRACT(SD,6,7)_$JUSTIFY("",SI+SI-6)_ST
+14 SET DATA(.01)=SDD
SET DATA(1)=ST
+15 DO ADDPATT^MBAAMDA1(.DATA,SC,SDD)
+16 SET RETURN=1
End DoDot:1
if RETURN=0
QUIT 0
+17 SET RETURN=1
+18 QUIT 1
DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
+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
+2 ;CANDELCO(RETURN) ; Check if user can delete check out data
+3 ; N KEYS,SUP K RETURN
+4 ; S KEYS("SD SUPERVISOR")=""
+5 ; D GETXUS^MBAAMDA3(.SUP,.KEYS,DUZ)
+6 ; I '$D(SUP("SD SUPERVISOR")) S RETURN=0 D ERRX^MBAAAPIE(.RETURN,"APTCOSU") Q 0
+7 ; S RETURN=1
+8 ; Q 1
+9 ;
+10 ;DELCODT(RETURN,SDOE) ;Delete Check Out Process Completion Date
+11 ; D DELCODT^MBAAMDA4(.RETURN,SDOE)
+12 ; S RETURN=1
+13 ; Q 1
+14 ;
+15 ;ADDTSTS(RETURN,DFN,SD,LAB,XRAY,EKG) ; Append tests to pending appointment
+16 ; N DATA,ERR
+17 ; K RETURN
+18 ; S %=$$ISOECO^MBAAMAP4(.ERR,DFN,SD,"add")
+19 ; I ERR=1 M RETURN=ERR S RETURN=0 Q 0
+20 ; S:$D(LAB) DATA(5)=LAB
+21 ; S:$D(XRAY) DATA(6)=XRAY
+22 ; S:$D(EKG) DATA(7)=EKG
+23 ; D UPDPAPT^MBAAMDA4(.DATA,DFN,SD)
+24 ; S RETURN=1
+25 ; Q 1
+26 ;
+27 ;DELTSTS(RETURN,DFN,SD,LAB,XRAY,EKG) ; Delete tests from pending appointment
+28 ; N DATA,ERR
+29 ; K RETURN
+30 ; S %=$$ISOECO^MBAAMAP4(.ERR,DFN,SD,"delete")
+31 ; I ERR=1 M RETURN=ERR S RETURN=0 Q 0
+32 ; S:$D(LAB) DATA(5)="@"
+33 ; S:$D(XRAY) DATA(6)="@"
+34 ; S:$D(EKG) DATA(7)="@"
+35 ; D UPDPAPT^MBAAMDA4(.DATA,DFN,SD)
+36 ; S RETURN=1
+37 ; Q 1
+38 ;
ISAPTCO(RETURN,DFN,SD) ; Is appointment checked out? Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
+1 NEW APT,FLDS
+2 SET FLDS="303"
+3 DO GETCAPT^MBAAMDA4(.APT,+DFN,+SD,.FLDS,"I")
+4 SET RETURN=1
+5 QUIT $GET(APT(303,"I"))>0
+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 ;ISOECO(RETURN,DFN,SD,OP) ; Is outpatient encounter checked out?
+8 ;N OE,APT,FLDS,PARAM
+9 ;S RETURN=0,DFN=+DFN,PARAM(1)=OP
+10 ;S OE(.12)="",FLDS="21"
+11 ;D GETPAPT^MBAAMDA4(.APT,+DFN,+SD,.FLDS)
+12 ;I $G(APT(21,"I"))="" Q 1
+13 ;D GETOE^MBAAMDA4(.OE,APT(21,"I"))
+14 ;I OE(.12)=2 D BLD^DIALOG(480000.03,.OP,,"RETURN","FS") S RETURN=1
+15 ;Q 1
+16 ;
GETHOL(RETURN,SD) ; Get holiday MBAA RPC: MBAA APPOINTMENT MAKE
+1 DO GETHOL^MBAAMDA1(.RETURN,SD)
+2 QUIT 1
