Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MBAAMAP4

MBAAMAP4.m

Go to the documentation of this file. 
  1. MBAAMAP4 ;OIT-PD/VSL - APPOINTMENT API ;02/10/2016
  1.  ;;1.0;Scheduling Calendar View;**1**;Feb 13, 2015;Build 85
  1.  ;
  1.  ;Associated ICRs
  1.  ; ICR#
  1.  ; 
  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
  1.  ;CHECKO(RETURN,DFN,SD,SC) ; Check out
  1.  ;N CAPT,OE,APT0,CD,%
  1.  ;S RETURN=0
  1.  ;S %=$$GETSCAP^MBAAMAP1(.CAPT,SC,DFN,SD)
  1.  ;I '$D(CAPT) D ERRX^MBAAAPIE(.RETURN,"APTCOCN") Q 0
  1.  ;S APT0=$$GETAPT0^MBAAMDA2(DFN,SD)
  1.  ;S STATUS=$$STATUS^SDAM1(DFN,SD,+$G(APT0),$G(APT0))
  1.  ;K % S %=$$CHKCO(.RETURN,DFN,SD,+STATUS)
  1.  ;Q:'RETURN 0
  1.  ;I '$$NEW^SDPCE(SD) D ERRX^MBAAAPIE(.RETURN,"APTCONW",,2)
  1.  ;S CD(304)=DUZ,CD(303)=$E($$NOW^XLFDT(),1,12)
  1.  ;D UPDCAPT^MBAAMDA4(.CD,SC,SD,CAPT("IFN"))
  1.  ;S RETURN("SDOE")=$$GETAPT(DFN,SD,SC)
  1.  ;S RETURN("COD")=CAPT("CHECKOUT")
  1.  ;S OE(.04)="",OE(.05)=""
  1.  ;D GETOE^MBAAMDA4(.OE,RETURN("SDOE"))
  1.  ;S RETURN("LOCATION")=OE(.04)
  1.  ;S RETURN("VISIT")=OE(.05)
  1.  ;S RETURN("COVISIT")=$P(APT0,U,11)
  1.  ;I "^2^8^12^"[("^"_+STATUS_"^"),$P(STATUS,";",3)["CHECKED OUT" D
  1.  ;. S RETURN("CO")=1 S RETURN=0
  1.  ;. D ERRX^MBAAAPIE(.RETURN,"APTCOAC",,2)
  1.  ;Q 1
  1.  ;
  1.  ;GETAPT(DFN,SDT,SDCL,SDVIEN) ;Look-up Outpatient Encounter IEN for Appt
  1.  ; Input  -- DFN      Patient file IEN
  1.  ;           SDT      Appointment Date/Time
  1.  ;           SDCL     Hospital Location file IEN for Appt
  1.  ;           SDVIEN   Visit file pointer [optional]
  1.  ; Output -- Outpatient Encounter file IEN
  1.  ;N PAPT
  1.  ;S PAPT(21)=""
  1.  ;D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
  1.  ;I 'PAPT(21) D APPT^SDVSIT(DFN,SDT,SDCL,$G(SDVIEN)) D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
  1.  ;I PAPT(21) D VIEN^SDVSIT2(PAPT(21),$G(SDVIEN))
  1.  ;Q +$G(PAPT(21))
  1.  ;
  1.  ;CHKCO(RETURN,DFN,SD,STATUS) ; Check in check out
  1.  ;S RETURN=0
  1.  ;I '$D(STATUS) D
  1.  ;. S APT0=$$GETAPT0^MBAAMDA2(DFN,SD)
  1.  ;. S STATUS=$$STATUS^SDAM1(DFN,SD,+$G(APT0),$G(APT0))
  1.  ;S %=$$CHKSPCO(.RETURN,DFN,SD,+STATUS) Q:'% 0
  1.  ;S DT=$$NOW^XLFDT
  1.  ;I $P(SD,".")>DT D ERRX^MBAAAPIE(.RETURN,"APTCOTS") Q 0
  1.  ;Q 1
  1.  ;
  1.  ;CHKSPCO(RETURN,DFN,SD,STATUS) ; Check if status permit check in
  1.  ;N IND,STAT,STATS
  1.  ;S RETURN=0
  1.  ;D LSTCOST1^MBAAMDA2(.STAT)
  1.  ;D BLDLST^MBAAMAPI(.STATS,.STAT)
  1.  ;S IND=0
  1.  ;F  S IND=$O(STATS(IND)) Q:IND=""!(RETURN=1)  D
  1.  ;. I STATS(IND,"ID")=STATUS S RETURN=1 Q
  1.  ;I 'RETURN D ERRX^MBAAAPIE(.RETURN,"APTCOCE")
  1.  ;Q RETURN
  1.  ;
  1.  ;CHKDCO(RETURN,DFN,SD) ; Check delete check out
  1.  ;N PAPT,CAPT,OE,SDATA,SDELHDL,X,%
  1.  ;S PAPT(21)="",PAPT(.01)=""
  1.  ;S OE(.01)="",OE(.04)="",OE(.05)="",OE(.08)="",OE(.09)="",OE(.06)=""
  1.  ;D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
  1.  ;S %=$$GETSCAP^MBAAMAP1(.CAPT,PAPT(.01),DFN,SD)
  1.  ;D GETOE^MBAAMDA4(.OE,PAPT(21))
  1.  ;S RETURN=0
  1.  ;I 'PAPT(21)!('CAPT("CHECKOUT")) D ERRX^MBAAAPIE(.RETURN,"APTDCOD") Q 0
  1.  ;I '$$NEW^SDPCE(OE(.01)) D ERRX^MBAAAPIE(.RETURN,"APTDCOO") Q 0
  1.  ;S RETURN=1
  1.  ;Q 1
  1.  ;
  1.  ;DELCOPC(RETURN,SDOE,SDELHDL,SDELSRC) ; Delete check out (PCE)
  1.  ;N SC,OE,SDDA,SDEVTF,X
  1.  ;D SETCO(.SDOE,.DFN,.SD,.OE,.SC,.SDDA)
  1.  ;I $G(SDELSRC)'="PCE" S X=$$DELVFILE^PXAPI("ALL",OE(.05),"","","")
  1.  ;I '$$NEW^SDPCE(SD) D ERRX^MBAAAPIE(.RETURN,"APTDCOO") Q 0
  1.  ;I '$G(SDELHDL) N SDATA,SDELHDL S SDEVTF=1 D EVT^SDCOU1(SDOE,"BEFORE",.SDELHDL,.SDATA)
  1.  ;S %=$$DELCOL(.RETURN,DFN,SD,SC,SDDA,SDOE,.OE)
  1.  ;I $G(SDEVTF) D EVT^SDCOU1(SDOE,"AFTER",.SDELHDL,.SDATA)
  1.  ;S RETURN=1
  1.  ;Q 1
  1.  ;
  1.  ;DELCO(RETURN,DFN,SD) ;Delete check-out (SD) silent version
  1.  ;N TXT
  1.  ;K RETURN
  1.  ;S RETURN=0
  1.  ;I +$G(DFN)'>0 S TXT(1)="DFN" D ERRX^MBAAAPIE(.RETURN,"INVPARAM",.TXT) Q 0
  1.  ;I +$G(SD)'>0 S TXT(1)="SD" D ERRX^MBAAAPIE(.RETURN,"INVPARAM",.TXT) Q 0
  1.  ;Q $$DELCOSD(.RETURN,DFN,SD)
  1.  ;
  1.  ;DELCOSD(RETURN,DFN,SD,ECHO) ; Delete check out (SD)
  1.  ;N %
  1.  ;S %=$$CHKDCO(.RETURN,DFN,SD)
  1.  ;I RETURN=0 Q 0
  1.  ;N SDOE,SC,OE,SDDA,X
  1.  ;D SETCO(.SDOE,.DFN,.SD,.OE,.SC,.SDDA)
  1.  ;I '$$NEW^SDPCE(SD) D ERRX^MBAAAPIE(.RETURN,"APTDCOO") Q 0
  1.  ;S SDELHDL=$$HANDLE^SDAMEVT(1)
  1.  ;S X=$$DELVFILE^PXAPI("ALL",OE(.05),"","","",.ECHO)
  1.  ;S %=$$DELCOL(.RETURN,DFN,SD,SC,SDDA,SDOE,.OE)
  1.  ;S SDOE=$$GETAPT(DFN,SD,SC)
  1.  ;S RETURN("OE")=SDOE
  1.  ;Q 1
  1.  ;
  1.  ;SETCO(SDOE,DFN,SD,OE,SC,SDDA) ; Set Check out params
  1.  ;N PAPT,CAPT,%
  1.  ;I '$D(SDOE) D
  1.  ;. S PAPT(21)="",PAPT(.01)=""
  1.  ;. D GETPAPT^MBAAMDA2(.PAPT,DFN,SD)
  1.  ;. S SDOE=PAPT(21),SC=PAPT(.01)
  1.  ;S OE(.01)="",OE(.02)="",OE(.04)="",OE(.05)="",OE(.08)="",OE(.09)="",OE(.06)=""
  1.  ;D GETOE^MBAAMDA4(.OE,SDOE)
  1.  ;S DFN=OE(.02),SD=OE(.01),SC=OE(.04)
  1.  ;S %=$$GETSCAP^MBAAMAP1(.CAPT,SC,DFN,SD)
  1.  ;S SDDA=CAPT("IFN")
  1.  ;Q
  1.  ;
  1.  ;DELCOL(RETURN,DFN,SD,SC,SDDA,SDOE,OE) ; Delete check out
  1.  ;N SDATA,SDELHDL,SDORG,VSIT
  1.  ;S SDORG=OE(.08),VSIT=OE(.05)
  1.  ;I "^1^2^3^"[("^"_SDORG_"^") D DELCHLD(SDOE)
  1.  ;N PDATA
  1.  ;I SDORG=1 D
  1.  ;. S PDATA(21)="@"
  1.  ;. N CDATA S CDATA(303)="@"
  1.  ;. D UPDCAPT^MBAAMDA4(.CDATA,SC,SD,SDDA)
  1.  ;I SDORG=3 D
  1.  ;. S PDATA(18)="@"
  1.  ;D UPDPAPT^MBAAMDA4(.PDATA,DFN,SD)
  1.  ;D DELCLS^MBAAMDA4(SDOE)
  1.  ;D DELOE(SDOE,.OE)
  1.  ; -- call pce to make sure its data is gone
  1.  ;D DEAD^PXUTLSTP(VSIT)
  1.  ;Q 1
  1.  ;
  1.  ;DELOE(SDOE,OE) ; Delete Outpatient Encounter
  1.  ;I '$D(OE) D
  1.  ;. S OE(.05)="",OE(.01)="",OE(.08)=""
  1.  ;. D GETOE^MBAAMDA4(.OE,SDOE)
  1.  ;I '$$NEW^SDPCE(OE(.01)) Q
  1.  ;D DELOE^MBAAMDA4(SDOE)
  1.  ;S X=$$KILL^VSITKIL(OE(.05))
  1.  ;Q
  1.  ;
  1.  ;DELCHLD(SDOEP) ;Delete Children
  1.  ;N SDOEC,CHLD
  1.  ;S SDOEC=0
  1.  ;D GETCHLD^MBAAMDA4(.CHLD,SDOEP)
  1.  ;F  S SDOEC=$O(CHLD(SDOEC)) Q:'SDOEC  D
  1.  ;. D DELOE(SDOEC)
  1.  ;Q
  1.  ;
  1.  ;LSTDAYAP(RETURN,DFN) ; List all day active appointment
  1.  ; N DAP,PAP,CAP,PFLDS,CFLDS,AP,FLD,NM,PNMS,CNMS,TXT
  1.  ; I '$D(DT) S DT=$P($$NOW^XLFDT(),".")
  1.  ; I '$D(DFN)!(+$G(DFN)'>0) S RETURN=0,TXT(1)="DFN" D ERRX^MBAAAPIE(.RETURN,"INVPARAM",.TXT)
  1.  ; S PFLDS=".01;3",CFLDS=".01;222;333"
  1.  ; S PNMS="CLINIC;STATUS",CNMS="PATIENT;CIFN;IFN"
  1.  ; D GETDAPTS^MBAAMDA2(.DAP,+DFN,$P(DT,"."))
  1.  ; S AP=0
  1.  ; F  S AP=$O(DAP(AP)) Q:AP=""  D
  1.  ; . I DAP(AP,2)["C"!(DAP(AP,2)["N")!(DAP(AP,2)="NT") Q
  1.  ; . D GETPAPT^MBAAMDA4(.PAP,+DFN,AP,PFLDS)
  1.  ; . F FLD=0:0 S FLD=$O(PAP(FLD)) Q:'FLD  D
  1.  ; . . S NM=$$FLDNAME^MBAAMUTL(PFLDS,PNMS,FLD)
  1.  ; . . S RETURN(AP,NM)=PAP(FLD,"I")_U_PAP(FLD,"E")
  1.  ; . D GETCAPT^MBAAMDA4(.CAP,+DFN,AP,CFLDS)
  1.  ; . F FLD=0:0 S FLD=$O(CAP(FLD)) Q:'FLD  D
  1.  ; . . S NM=$$FLDNAME^MBAAMUTL(CFLDS,CNMS,FLD)
  1.  ; . . S RETURN(AP,"C",NM)=CAP(FLD)
  1.  ; Q 1
  1.  ; ;
  1.  ;GETPAPT(RETURN,DFN,SD) ; Get patient appointment
  1.  ; N IND,NAME,FLDS,NAMES,APT
  1.  ; S FLDS=".01;3;5;6;7;9;12;13;14;15;16;9.5;17;19;20;21;25;26;27;28"
  1.  ; S NAMES="CLINIC;STATUS;LABDT;XRAYDT;EKGDT;PURPOSE;ARBK;CVISIT;NOSHOWBY;NOSHOWDT;"
  1.  ; S NAMES=NAMES_"CREASON;TYPE;CREMARKS;ENTRY;MADEDT;OE;RTYPE;NEXTA;DDATE;FVISIT"
  1.  ; D GETPAPT^MBAAMDA4(.APT,DFN,SD)
  1.  ; F IND=0:0 S IND=$O(APT(IND)) Q:IND=""  D
  1.  ; . S NAME=$$FLDNAME^MBAAMUTL(FLDS,NAMES,IND)
  1.  ; . S RETURN(NAME)=APT(IND,"E")
  1.  ; . S RETURN(NAME,"I")=APT(IND,"I")
  1.  ; S RETURN=1
  1.  ; Q 1
  1.  ; ;
  1.  ;GETCAPT(RETURN,DFN,SD) ; Get clinic appointment
  1.  ; N IND,NAME,FLDS,NAMES,CAPT
  1.  ; S FLDS=".01;1;3;7;8;9;30;309;302;303;304;306;222;333"
  1.  ; S NAMES="PATIENT;LENGTH;OTHER;ENTRY;MADEDT;OVERBOOK;EVISIT;CIDT;"
  1.  ; S NAMES=NAMES_"CIUSER;CODT;COUSER;COENTER;222;333"
  1.  ; D GETCAPT^MBAAMDA4(.CAPT,DFN,SD)
  1.  ; F IND=0:0 S IND=$O(CAPT(IND)) Q:IND=""  D
  1.  ; . S NAME=$$FLDNAME^MBAAMUTL(FLDS,NAMES,IND) Q:NAME=""
  1.  ; . S RETURN(NAME)=CAPT(IND)
  1.  ; S RETURN("STATUS")=$$STATUS^SDAM1(DFN,SD,CAPT(222),CAPT(333))
  1.  ; S RETURN=1
  1.  ; Q 1
  1.  ; ;
  1.  ;GETOE(RETURN,SDOE) ; Get outpatient encounter
  1.  ; K RETURN
  1.  ; S RETURN(.07)="",RETURN(.08)="",RETURN(.01)="",RETURN(.02)=""
  1.  ; S RETURN(.03)="",RETURN(.04)="",RETURN(.05)=""
  1.  ; D GETOE^MBAAMDA4(.RETURN,SDOE)
  1.  ; Q:'$D(RETURN) 0
  1.  ; S RETURN("DATE")=RETURN(.01)
  1.  ; S RETURN("PATIENT")=RETURN(.02)
  1.  ; S RETURN("SCODE")=RETURN(.03)
  1.  ; S RETURN("CLINIC")=RETURN(.04)
  1.  ; S RETURN("VISIT")=RETURN(.05)
  1.  ; Q 1
  1.  ;
  1.  ;GETPAT(RETURN,DFN) ; Get patient
  1.  ;N IND,NAME,FLDS,NAMES,PAT
  1.  ;S RETURN=0
  1.  ;S FLDS=".01;.02;.03;.05;.08;.361;.323;.131;.111;.134;.112;.135;.1173;.1112;"
  1.  ;S FLDS=FLDS_".114;.115;.1172;.1171;.133;.32103;.525;.32102;.3213;.32115;.322013"
  1.  ;S NAMES="PATIENT;SEX;BIRTH;MSTATUS;RELIG;PELIG;PSERV;PHONE;ADD1;"
  1.  ;S NAMES=NAMES_"CELL;ADD2;PAGER;COUNTRY;ZIP;CITY;STATE;PCODE;PROVINCE;"
  1.  ;S NAMES=NAMES_"EMAIL;EXPOI;POWSTAT;AGENTO;AGENTOL;PROJ;SASIA"
  1.  ;D GETPAT^MBAAMDA4(.PAT,DFN)
  1.  ;F IND=0:0 S IND=$O(PAT(IND)) Q:IND=""  D
  1.  ;. S NAME=$$FLDNAME^MBAAMUTL(FLDS,NAMES,IND) Q:NAME=""
  1.  ;. S RETURN(NAME)=PAT(IND,"E")
  1.  ;. S RETURN(NAME,"I")=PAT(IND,"I")
  1.  ;S RETURN=1
  1.  ;Q 1
  1.  ;
  1.  ;GETCHLD(RETURN,SDOE) ; Get children encounters
  1.  ; D GETCHLD^MBAAMDA4(.RETURN,SDOE)
  1.  ; S RETURN=1
  1.  ; Q 1
  1.  ; 
  1. DOW(SD) ;  Called by RPC MBAA APPOINTMENT MAKE
  1.  N Y
  1.  S %=$E(SD,1,3),Y=$E(SD,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)
  1.  F %=%:-1:281 S Y=%#4=1+1+Y
  1.  S Y=$E(SD,6,7)+Y#7
  1.  Q Y
  1.  ;
  1. SETST(RETURN,SC,SD) ; Called by RPC MBAA APPOINTMENT MAKE
  1.  N SDD,ST,PATT,CLN,DATA,SI,DOW
  1.  S SDD=$P(SD,".",1)
  1.  S ST=$$GETDST^MBAAMDA1(SC,SDD)
  1.  S RETURN=0
  1.  I $G(ST)']"" D  Q:RETURN=0 0
  1.  . S DOW=$$DOW(SD)
  1.  . D GETDPATT^MBAAMDA1(.PATT,SC,SDD,DOW)
  1.  . I PATT("IEN")'>0!($G(PATT("PAT"))="") D ERRX^MBAAAPIE(.RETURN,"APTWHEN") Q
  1.  . S ST=PATT("PAT")
  1.  . S CLN(1917)=""
  1.  . D GETCLNX^MBAAMDA1(.CLN,SC)
  1.  . S SI=CLN(1917),SI=$S(SI="":4,SI<3:4,SI:SI,1:4)
  1.  . S ST=$E($P($T(DAY),U,DOW+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_ST
  1.  . S DATA(.01)=SDD,DATA(1)=ST
  1.  . D ADDPATT^MBAAMDA1(.DATA,SC,SDD)
  1.  . S RETURN=1
  1.  S RETURN=1
  1.  Q 1
  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
  1.  ;CANDELCO(RETURN) ; Check if user can delete check out data
  1.  ; N KEYS,SUP K RETURN
  1.  ; S KEYS("SD SUPERVISOR")=""
  1.  ; D GETXUS^MBAAMDA3(.SUP,.KEYS,DUZ)
  1.  ; I '$D(SUP("SD SUPERVISOR")) S RETURN=0 D ERRX^MBAAAPIE(.RETURN,"APTCOSU") Q 0
  1.  ; S RETURN=1
  1.  ; Q 1
  1.  ;
  1.  ;DELCODT(RETURN,SDOE) ;Delete Check Out Process Completion Date
  1.  ; D DELCODT^MBAAMDA4(.RETURN,SDOE)
  1.  ; S RETURN=1
  1.  ; Q 1
  1.  ;
  1.  ;ADDTSTS(RETURN,DFN,SD,LAB,XRAY,EKG) ; Append tests to pending appointment
  1.  ; N DATA,ERR
  1.  ; K RETURN
  1.  ; S %=$$ISOECO^MBAAMAP4(.ERR,DFN,SD,"add")
  1.  ; I ERR=1 M RETURN=ERR S RETURN=0 Q 0
  1.  ; S:$D(LAB) DATA(5)=LAB
  1.  ; S:$D(XRAY) DATA(6)=XRAY
  1.  ; S:$D(EKG) DATA(7)=EKG
  1.  ; D UPDPAPT^MBAAMDA4(.DATA,DFN,SD)
  1.  ; S RETURN=1
  1.  ; Q 1
  1.  ;
  1.  ;DELTSTS(RETURN,DFN,SD,LAB,XRAY,EKG) ; Delete tests from pending appointment
  1.  ; N DATA,ERR
  1.  ; K RETURN
  1.  ; S %=$$ISOECO^MBAAMAP4(.ERR,DFN,SD,"delete")
  1.  ; I ERR=1 M RETURN=ERR S RETURN=0 Q 0
  1.  ; S:$D(LAB) DATA(5)="@"
  1.  ; S:$D(XRAY) DATA(6)="@"
  1.  ; S:$D(EKG) DATA(7)="@"
  1.  ; D UPDPAPT^MBAAMDA4(.DATA,DFN,SD)
  1.  ; S RETURN=1
  1.  ; Q 1
  1.  ;
  1. ISAPTCO(RETURN,DFN,SD) ; Is appointment checked out? Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT
  1.  N APT,FLDS
  1.  S FLDS="303"
  1.  D GETCAPT^MBAAMDA4(.APT,+DFN,+SD,.FLDS,"I")
  1.  S RETURN=1
  1.  Q $G(APT(303,"I"))>0
  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
  1.  ;ISOECO(RETURN,DFN,SD,OP) ; Is outpatient encounter checked out?
  1.  ;N OE,APT,FLDS,PARAM
  1.  ;S RETURN=0,DFN=+DFN,PARAM(1)=OP
  1.  ;S OE(.12)="",FLDS="21"
  1.  ;D GETPAPT^MBAAMDA4(.APT,+DFN,+SD,.FLDS)
  1.  ;I $G(APT(21,"I"))="" Q 1
  1.  ;D GETOE^MBAAMDA4(.OE,APT(21,"I"))
  1.  ;I OE(.12)=2 D BLD^DIALOG(480000.03,.OP,,"RETURN","FS") S RETURN=1
  1.  ;Q 1
  1.  ;
  1. GETHOL(RETURN,SD) ; Get holiday MBAA RPC: MBAA APPOINTMENT MAKE
  1.  D GETHOL^MBAAMDA1(.RETURN,SD)
  1.  Q 1