BEHOENCX ;MSC/IND/DKM - Encounter Context Support ;27-May-2014 14:53;DU
;;1.1;BEH COMPONENTS;**005003,005004,005007,005010,005011**;Sep 18, 2007;Build 1
;=================================================================
; RPC: Fetch visit data given visit file IEN
; Returns hosp loc^visit date^service category^dfn^visit id^locked
; IHS/MGH/MGH EHR 12 allow I visits that have hospital locations to be visible
;=================================================================
GETVISIT(DATA,IEN) ;EP
N VSIT,DLM
S (DLM,DATA)=""
Q:$$LOOKUP^VSIT(IEN,"I",0)<1
Q:$G(VSIT("DEL"))
F VSIT="LOC","VDT","SVC","PAT","VID" S DATA=DATA_DLM_VSIT(VSIT),DLM=U
S DATA=DATA_U_$$ISLOCKED(IEN)
Q
; RPC: Fetch visit IEN given visit id
VID2IEN(DATA,VID) ;EP
S DATA=$$VID2IEN^VSIT(VID)
Q
; RPC: Return IEN of hospital location
LOCIEN(DATA,LOC) ;EP
S DATA=$$FIND1^DIC(44,"","QX",LOC)
Q
; RPC: Return values for specified encounter
; DFN = Patient IEN
; VSTR = Visit string (extended)
; PRV = Provider
; CREATE= -1=Always, 0=never, 1=If not found
; Return value =
; 1 2 3 4 5 6 7 8 9
; LOCNAME^LOCABBR^ROOMBED^PROVIEN^PROVNAME^VISITIEN^VISITID^LOCKED^ERRORTXT
FETCH(DATA,DFN,VSTR,PRV,CREATE) ;EP
N IEN,X,FETCH
S PRV=+$G(PRV)
S FETCH=$$GET^XPAR("ALL","BEHOENCX PROV ENC FETCH")
I 'PRV,$$ISPROV^BEHOUSCX S PRV=DUZ
S IEN=$$VSTR2VIS(DFN,.VSTR,.CREATE,PRV)
I IEN>0,'PRV,FETCH D
.D GETPRV2(.X,IEN,1)
.S PRV=+$O(X(0))
S DATA=$P($G(^SC(+VSTR,0)),U,1,2)
S $P(DATA,U,3)=$P($G(^DPT(DFN,.101)),U)
S $P(DATA,U,4)=PRV
S $P(DATA,U,5)=$P($G(^VA(200,PRV,0)),U)
I IEN>0 S $P(DATA,U,6)=IEN,$P(DATA,U,7)=$P($G(^AUPNVSIT(IEN,150)),U),$P(DATA,U,8)=$$ISLOCKED(IEN)
E S $P(DATA,U,9)=$P(IEN,U,2)
Q
; RPC: Return location info
; Returns 0 node of HOSPITAL LOCATION file for specified entry.
LOCINFO(DATA,LOC) ;
Q $G(^SC(+LOC,0))
; Find a visit
; DFN = Patient IEN
; DAT = Visit date/time
; CAT = Service category
; LOC = Value to compare (location or stop code)
; CRE = Force create?
; PRV = Provider IEN to restrict search (optional)
; ELC = Encounter location (optional)
; Returns one of:
; If found or created: visit ien
; If not found: 0
; If error: -1^error message
FNDVIS(DFN,DAT,CAT,LOC,CRE,PRV,ELC) ;PEP - Find a visit
N IN,OUT,IEN,DIF
S IN("PAT")=DFN
S IN("VISIT DATE")=DAT
S IN("VISIT TYPE")=$S(CAT="E":"O",1:$S($G(DUZ("AG"))="I":$$GET1^DIQ(9001000,DUZ(2),.04,"I"),1:$$GET^XPAR("ALL","BEHOENCX VISIT TYPE")))
S IN("SRV CAT")=CAT
S IN("TIME RANGE")=60
S IN("USR")=DUZ
S:$G(LOC) IN("HOS LOC")=LOC
S:$G(XQY) IN("APCDOPT")=XQY
S:$G(PRV) IN("PROVIDER")=PRV
S ELC=$G(ELC)
I $L(ELC),ELC'=+ELC D
.S IN("APCDOLOC")=ELC
.S ELC=$$GET^XPAR("ALL","BEHOENCX OTHER LOCATION")
S IN("SITE")=$S(ELC:ELC,$P($G(^SC(+$G(LOC),0)),U,4):$P(^(0),U,4),1:DUZ(2))
I 'CRE S IN("NEVER ADD")=1
E I CRE<0 S IN("FORCE ADD")=1
I $G(DUZ("AG"))="I" D
.D GETVISIT^BSDAPI4(.IN,.OUT)
E D GETVISIT^BEHOENC1(.IN,.OUT)
Q:'OUT(0) $S(OUT(0)[U:"-1^"_$P(OUT(0),U,2),1:0)
S IEN=0,DIF=999999
F S IEN=$O(OUT(IEN)) Q:'IEN D
.I OUT(IEN)="ADD" D
..N VSTR
..S VSTR=$$VIS2VSTR(DFN,IEN)
..D BRDCAST^CIANBEVT("PCC."_DFN_".VST",VSTR)
..D:$G(PRV) UPDPRV(,DFN,VSTR,PRV)
.S:$$ABS(OUT(IEN))<DIF DIF=$$ABS(OUT(IEN)),IEN(0)=IEN
Q IEN(0)
; Return absolute value
ABS(X) Q $S(X<0:-X,1:X)
; Return a visit ien from a visit string (create if necessary)
; DFN = Patient IEN
; VSTR = Visit string
; CREATE = Create flag
; 0 = Don't create
; >0 = Create if not found
; <0 = Always create
; PRV = Provider IEN to restrict visit search (optional)
VSTR2VIS(DFN,VSTR,CREATE,PRV) ;PEP - Convert visit string to visit IEN
N IEN,DAT,CAT,LOC,FLG,VSIT,LP
S LOC=+VSTR,DAT=+$P(VSTR,";",2),CAT=$P(VSTR,";",3),IEN=+$P(VSTR,";",4),CREATE=+$G(CREATE)
I 'IEN,CREATE'<0 S IEN=$$FNDVIS(DFN,DAT,CAT,LOC,0,.PRV)
I 'IEN,CREATE'<0 S IEN=$$FNDVIS(DFN,DAT,CAT,LOC,0)
I 'IEN,CREATE S IEN=$$FNDVIS(DFN,DAT,CAT,LOC,CREATE,.PRV)
S:IEN>0 VSTR=$$VIS2VSTR(DFN,IEN,.IEN),$P(VSTR,";")=LOC
Q IEN
; Return a visit string given visit ien
VIS2VSTR(DFN,IEN,ERR) ;PEP - Convert visit IEN to visit string
N VSTR
S VSTR=$G(^AUPNVSIT(+IEN,0))
I '$L(VSTR) S ERR="-1^Visit does not exist"
E I $P(VSTR,U,5)'=DFN S ERR="-1^Visit does not belong to current patient",VSTR=""
E S VSTR=$P(VSTR,U,22)_";"_+VSTR_";"_$P(VSTR,U,7)_";"_IEN
Q VSTR
; RPC: Return a list of appointments
; APPTTIME^LOCIEN^LOCNAME^EXTSTATUS
APPTLST(DATA,DFN) ;EP
N VASD,I
S VASD("F")=$$HTFM^XLFDT($H-30,1)
S VASD("T")=$$HTFM^XLFDT($H+1,1)_".2359"
S VASD("W")="123456789"
D SDA^VADPT
S I=0
F S I=$O(^UTILITY("VASD",$J,I)) Q:'I D
.S DATA(I)=$P(^UTILITY("VASD",$J,I,"I"),U,1,2)_U_$P(^("E"),U,2,3)
K ^UTILITY("VASD",$J)
Q
; RPC: Return a list of admissions
; VSTR^LOCNAME^ADMDATE^TYPE^LOCKED
ADMITLST(DATA,DFN,BEG,END) ;EP
N TIM,MOV,CNT,IDT,IDT2
S CNT=0,TIM=""
S:'$G(BEG) BEG=2000000
S:'$G(END) END=DT
S IDT2=9999999-(BEG\1)+.9,IDT=9999999-(END\1)
F Q:'IDT!(IDT>IDT2) D S IDT=$O(^DGPM("ATID1",DFN,IDT))
.S MOV=0 F S MOV=$O(^DGPM("ATID1",DFN,IDT,MOV)) Q:MOV'>0 D
..S X=$$ADMITINF(DFN,MOV)
..S:X CNT=CNT+1,DATA(CNT)=X
Q
; RPC: Return current admission info
; VSTR^LOCNAME^ADMDATE^TYPE^LOCKED
ADMITCUR(DATA,DFN) ;EP
S DATA=$$ADMITINF(DFN,+$G(^DPT(DFN,.105)))
Q
; Return admission info
; VSTR^LOCNAME^ADMDATE^TYPE^LOCKED
ADMITINF(DFN,MOV) ;EP
N VIEN,VSTR,LLOC,XLOC,HLOC,CMOV,AMOV,DMOV,LMOV,MTIM,XTYP,X0
S X0=$G(^DGPM(+MOV,0))
Q:$P(X0,U,3)'=DFN ""
S MTIM=$P(X0,U),DMOV=$P(X0,U,17),VIEN=$P(X0,U,27)
S:'$D(^AUPNVSIT(+VIEN,0)) VIEN=""
S CMOV=+$G(^DPT(DFN,.102)),AMOV=+$G(^(.105))
S XTYP=$P($G(^DG(405.1,+$P(X0,U,4),0)),U)
I MOV=AMOV,CMOV'=AMOV,$D(^DGPM(CMOV,0)) S LMOV=CMOV
E S LMOV=MOV
D AL2(MOV,.XLOC,.HLOC),AL2(LMOV,.LLOC,.HLOC):LMOV'=MOV
I $L($G(LLOC)),LLOC'=XLOC S XLOC=XLOC_" ("_LLOC_")"
S VSTR=HLOC_";"_MTIM_";H;"_VIEN
Q VSTR_U_XLOC_U_MTIM_U_XTYP_U_$$ISLOCKED(VIEN)
; Return ward location name and associated hospital location ien for movement
AL2(MOV,WLOC,HLOC) ;
S WLOC=+$P($G(^DGPM(MOV,0)),U,6),WLOC=$P($G(^DIC(42,WLOC,0)),U),HLOC=+$G(^(44))
Q
; RPC: Get discharge movement information
DISCHRG(DATA,DFN,ADMITDT) ;EP
N VAIP
S DATA=DT
Q:'$G(ADMITDT)
S VAIP("D")=ADMITDT
D 52^VADPT
S:VAIP(17) DATA=+VAIP(17,1)
Q
; Returns true if active hospital location
; LOC = IEN of hospital location
; DAT = optional date to check (defaults to today)
ACTLOC(LOC,DAT) ;PEP - Is active location?
N D0,X
S X=$G(^SC(LOC,0))
Q:'$L(X) 0 ; Screen nonexistent entries
S X=$P($G(^DG(40.8,+$P(X,U,15),0)),U,7)
I X,X'=DUZ(2) Q 0 ; Screen clinics not in current division
Q:+$G(^SC(LOC,"OOS")) 0 ; Screen OOS entry
S D0=+$G(^SC(LOC,42)),DAT=$G(DAT,DT)\1
I D0 D WIN^DGPMDDCF Q 'X ; Check out of svc wards
S X=$G(^SC(LOC,"I"))
Q:'X 1 ; No inactivate date
Q:DAT'<$P(X,U)&($P(X,U,2)=""!(DAT<$P(X,U,2))) 0 ; Check reactivate date
Q 1 ; Must still be active
; RPC: Return a set of hospital locations
HOSPLOC(DATA,FROM,DIR,MAX,TYPE,START,END) ;EP
N IEN,CNT,APT
S FROM=$G(FROM),DIR=$G(DIR,1),MAX=$G(MAX,44),TYPE=$G(TYPE),CNT=0
S START=$G(START)\1,END=$G(END)\1
S:'END END=START
F S FROM=$O(^SC("B",FROM),DIR),IEN="" Q:FROM="" D Q:CNT'<MAX
.F S IEN=$O(^SC("B",FROM,IEN),DIR) Q:'IEN D
..I $$ACTLOC(IEN),$P(^SC(IEN,0),U,3)[TYPE D
...I START S APT=$O(^SC(IEN,"S",START-.1))\1 Q:'APT!(APT>END)
...S CNT=CNT+1,DATA(CNT)=IEN_U_$P(^SC(IEN,0),U)_U_$S($G(DUZ("AG"))="I":$P($G(^BSDSC(IEN,0)),U,12),1:$P($G(^SC(IEN,0)),U,9))
Q
; RPC: Return a set of clinics
CLINLOC(DATA,FROM,DIR,MAX,START,END) ;EP
D HOSPLOC(.DATA,.FROM,.DIR,.MAX,"C",.START,.END)
Q
; RPC: Return a set of wards
INPLOC(DATA,FROM,DIR,MAX) ;EP
D HOSPLOC(.DATA,.FROM,.DIR,.MAX,"W")
Q
; RPC: Return appts/visits for patient
; DFN = Patient IEN
; BEG = Beginning date to search (optional)
; Defaults to BEHOENCX SEARCH RANGE START
; END = Ending date to search (optional)
; Defaults to BEHOENCX SEARCH RANGE END
; LOC = If not specified, return all locations and all active appointments
; If <0, return all locations and all appointments (except checked-in)
; If >0, return only specified location and only active appointments
; SCEXC = Contains service category types to exclude (defaults to HXI)
; IGPFLG = Ignore pending check-in appointments
; .DATA= List of results in format:
; VSTR^LOCNAME^DATE^STATUS^LOCKED^PRV^PRVNM^STANDALONE
VISITLST(DATA,DFN,BEG,END,LOC,SCEXC,IGPFLG) ;EP
N VAERR,VASD,CNT,IDT,IDT2,STS,DTM,LOCNAM,LOCIEN,VSTR,IEN,LP,XI,XE,X
S CNT=0,DATA=$$TMPGBL^CIAVMRPC,LOC=+$G(LOC)
S SCEXC=$G(SCEXC,"X") ;p9 removed H, p12 removed I
S:'$G(BEG) BEG=$$DTSTART
S:'$G(END) END=$$DTSTOP+.9
S:'$G(IGPFLG) IGPFLG=0
; Return list of visits for a patient
S IDT2=9999999-(BEG\1)+.9,IDT=9999999-(END\1)
F Q:'IDT!(IDT>IDT2) D S IDT=$O(^AUPNVSIT("AA",DFN,IDT))
.F IEN=0:0 S IEN=$O(^AUPNVSIT("AA",DFN,IDT,IEN)) Q:'IEN D
..N PRV
..S XI=$G(^AUPNVSIT(IEN,0)),DTM=+XI,LOCIEN=$P(XI,U,22),LOCNAM=$P($G(^SC(+LOCIEN,0),"Unknown"),U),X=$P(XI,U,7)
..Q:$P(XI,U,11) ; Ignore if logically deleted
..Q:'LOC&'LOCIEN
..Q:LOC>0&(LOC'=LOCIEN)
..D GETPRV2(.PRV,IEN,1)
..S PRV=$P($G(PRV(+$O(PRV(0)))),U,1,2)
..S VSTR=LOCIEN_";"_DTM_";"_X_";"_IEN,STS=$$SET^CIAU(X,$P($G(^DD(9000010,.07,0)),U,3))
..;IHS/MSC/MGH p12 allow I visits with location
..I X="I"&(+LOCIEN>0) S CNT=CNT+1,@DATA@(-DTM,CNT)=VSTR_U_LOCNAM_U_DTM_U_STS_U_$$ISLOCKED(IEN)_U_PRV_U_'$D(^SCE("AVSIT",IEN))
..E S:SCEXC'[X CNT=CNT+1,@DATA@(-DTM,CNT)=VSTR_U_LOCNAM_U_DTM_U_STS_U_$$ISLOCKED(IEN)_U_PRV_U_'$D(^SCE("AVSIT",IEN))
Q:LOC>0
Q:IGPFLG>0
; Get appointments pending check-in
S VASD("F")=$S(LOC<0:BEG,BEG<DT:DT,1:BEG)
S VASD("T")=END
S VASD("W")=$S(LOC<0:123456789,1:1)
D SDA^VADPT
S LP=0
F S LP=$O(^UTILITY("VASD",$J,LP)) Q:'LP D
.S XI=^UTILITY("VASD",$J,LP,"I"),XE=^("E")
.S DTM=$P(XI,U),LOCIEN=$P(XI,U,2),LOCNAM=$P(XE,U,2)
.Q:$$CHKDIN(DFN,LOCIEN,DTM)
.S XI=$G(^DPT(DFN,"S",DTM,0))
.Q:+XI'=LOCIEN
.S XI=$P(XI,U,20),STS=$S(LOC<0:$P(XE,U,3),1:"Pending Check-In")
.I XI,$P($G(^SCE(XI,0)),U,5) Q
.S VSTR=LOCIEN_";"_DTM_";A"
.S CNT=CNT+1,@DATA@(-DTM,CNT)=VSTR_U_LOCNAM_U_DTM_U_STS
K ^UTILITY("VASD",$J)
Q
; Returns true if checked in
CHKDIN(DFN,LOCIEN,DTM) ;
Q:$G(DUZ("AG"))="I" $$CI^BSDU2(DFN,LOCIEN,DTM)
Q ''$P($$STATUS^SDAMA308(DFN,DTM,LOCIEN),";",4)
; Returns visit lock status:
; -1: Visit not found
; 0: Visit is not locked
; 1: Visit is locked
ISLOCKED(IEN) ;PEP - Is visit locked?
N DAT,DAYS,EXPDT
S DAT=$$VISREFDT(IEN)
Q:'DAT -1
;IHS/MSC/PLS - 02/18/09 - Parameter now holds lock expiration date
S EXPDT=$$GET^XPAR("USR","BEHOENCX VISIT LOCK OVERRIDE","`"_IEN)
Q:EXPDT'<$$DT^XLFDT() 0
D:EXPDT DEL^XPAR("USR","BEHOENCX VISIT LOCK OVERRIDE","`"_IEN) ; remove expired locked
;Q:$$GET^XPAR("USR","BEHOENCX VISIT LOCK OVERRIDE","`"_IEN) 0
S DAYS=$$GET^XPAR("ALL","BEHOENCX VISIT LOCKED")
Q $$FMDIFF^XLFDT(DT,DAT)>$S(DAYS<1:1,1:DAYS)
; Returns reference date for visit lock check
VISREFDT(IEN) ;
N ADM,DIS,DAT
S DAT=$P($G(^AUPNVSIT(+IEN,0)),U,2)
Q:'DAT ""
S ADM=$O(^DGPM("AVISIT",IEN,0))
Q:'ADM DAT
S DIS=$P($G(^DGPM(ADM,0)),U,17)
Q $S(DIS:$P($G(^DGPM(DIS,0)),U),1:DT)
; RPC: Return providers associated with a visit (by VSTR)
; If PRI is set, returns primary only
; Returns as DATA(DUZ)=DUZ^Name^Primary^EncDT
GETPRV(DATA,DFN,VSTR,PRI) ;EP
D GETPRV2(.DATA,$$VSTR2VIS(DFN,VSTR,0),.PRI)
Q
; RPC: Return providers associated with a visit (by IEN)
; If PRI is set, returns primary only
; Returns as DATA(DUZ)=DUZ^Name^Primary^EncDT
GETPRV2(DATA,IEN,PRI) ;EP
N LP,ED,PP,PR,X
K DATA
S LP=0,IEN=+IEN,PRI=+$G(PRI)
F S LP=$O(^AUPNVPRV("AD",IEN,LP)) Q:'LP D
.S X=$G(^AUPNVPRV(LP,0)),ED=$P($G(^(12)),U),PP=$P(X,U,4)="P",PR=+X
.I $P(X,U,3)=IEN,'PRI!PP S DATA(PR)=PR_U_$$GET1^DIQ(200,PR,.01)_U_PP_U_ED
Q
; RPC: Add/Remove providers to/from a visit
UPDPRV(DATA,DFN,VSTR,PRV) ;EP
N PCC,ACT,PRI,PFG,RTN
S:$D(PRV)=1 PRV(PRV)="P"
S PRV="",PFG=0
F S PRV=$O(PRV(PRV)) Q:'$L(PRV) D
.S ACT=PRV(PRV),PRI=0
.S:ACT="P" PRI='PFG,ACT="+",PFG=1
.D ADDPCC("PRV"_ACT_U_PRV_"^^^^"_PRI)
D:$D(PCC) SAVE^BEHOENPC(.DATA,.PCC)
Q
; RPC: Check visit for missing elements
CHKVISIT(DATA,IEN) ;
Q:$T(+2^BEHOXQPC)=""
N RTN,CNT
S CNT=0
D NOPOV^BEHOXQPC(.RTN,IEN),CV1("POV")
D NOEMC^BEHOXQPC(.RTN,IEN),CV1("E&M")
Q
CV1(DX) S:$D(RTN) CNT=CNT+1,$P(RTN,U)=DX,DATA(CNT)=RTN
K RTN
Q
; Build PCC array
ADDPCC(X) ;
S:'$D(PCC) PCC(1)="HDR^^^"_VSTR,PCC(2)="VST^PT^"_DFN
S PCC($O(PCC(""),-1)+1)=X
Q
; VST may either be the visit ien or a visitstr
; Optionally returns success indicator
SETCTX(VST) ;PEP - Set the encounter context
N UID
S UID=$$GETUID^CIANBUTL
D:$L(UID) QUEUE^CIANBEVT("CONTEXT.ENCOUNTER",VST,UID)
Q:$Q ''$L(UID)
Q
; Return FM date given relative date
; DAT = Relative date (e.g., T+1)
; DFL = Default relative date (if DAT is not specified)
TOFM(DAT,DFL) ;
N %DT,X,Y
S X=$S(DAT="":DFL,1:DAT),%DT="TS"
D ^%DT
Q Y
; Return start date for encounters
DTSTART() ;EP
Q $$TOFM($$GET^XPAR("ALL","BEHOENCX SEARCH RANGE START",1,"I"),"T-365")
; Return stop date for encounters
DTSTOP() ;EP
Q $$TOFM($$GET^XPAR("ALL","BEHOENCX SEARCH RANGE STOP",1,"I"),"T+90")
; Return formatted visit detail report
ENINQ(DATA,VIEN) ;
S DATA=$$TMPGBL^CIAVMRPC
D CAPTURE^CIAUHFS($TR($$GET^XPAR($$ENT^CIAVMRPC("BEHOENCX DETAIL REPORT"),"BEHOENCX DETAIL REPORT"),"~",U),DATA,80)
Q
; Return boolean value represent if location is linked to stop code.
ISSTOPCD(DATA,LOCIEN,STOPCODE) ;EP-
S DATA=$$GET1^DIQ(40.7,$$GET1^DIQ(44,LOCIEN,8,"I"),1)=STOPCODE
Q
BEHOENCX ;MSC/IND/DKM - Encounter Context Support ;27-May-2014 14:53;DU
+1 ;;1.1;BEH COMPONENTS;**005003,005004,005007,005010,005011**;Sep 18, 2007;Build 1
+2 ;=================================================================
+3 ; RPC: Fetch visit data given visit file IEN
+4 ; Returns hosp loc^visit date^service category^dfn^visit id^locked
+5 ; IHS/MGH/MGH EHR 12 allow I visits that have hospital locations to be visible
+6 ;=================================================================
GETVISIT(DATA,IEN) ;EP
+1 NEW VSIT,DLM
+2 SET (DLM,DATA)=""
+3 IF $$LOOKUP^VSIT(IEN,"I",0)<1
QUIT
+4 IF $GET(VSIT("DEL"))
QUIT
+5 FOR VSIT="LOC","VDT","SVC","PAT","VID"
SET DATA=DATA_DLM_VSIT(VSIT)
SET DLM=U
+6 SET DATA=DATA_U_$$ISLOCKED(IEN)
+7 QUIT
+8 ; RPC: Fetch visit IEN given visit id
VID2IEN(DATA,VID) ;EP
+1 SET DATA=$$VID2IEN^VSIT(VID)
+2 QUIT
+3 ; RPC: Return IEN of hospital location
LOCIEN(DATA,LOC) ;EP
+1 SET DATA=$$FIND1^DIC(44,"","QX",LOC)
+2 QUIT
+3 ; RPC: Return values for specified encounter
+4 ; DFN = Patient IEN
+5 ; VSTR = Visit string (extended)
+6 ; PRV = Provider
+7 ; CREATE= -1=Always, 0=never, 1=If not found
+8 ; Return value =
+9 ; 1 2 3 4 5 6 7 8 9
+10 ; LOCNAME^LOCABBR^ROOMBED^PROVIEN^PROVNAME^VISITIEN^VISITID^LOCKED^ERRORTXT
FETCH(DATA,DFN,VSTR,PRV,CREATE) ;EP
+1 NEW IEN,X,FETCH
+2 SET PRV=+$GET(PRV)
+3 SET FETCH=$$GET^XPAR("ALL","BEHOENCX PROV ENC FETCH")
+4 IF 'PRV
IF $$ISPROV^BEHOUSCX
SET PRV=DUZ
+5 SET IEN=$$VSTR2VIS(DFN,.VSTR,.CREATE,PRV)
+6 IF IEN>0
IF 'PRV
IF FETCH
Begin DoDot:1
+7 DO GETPRV2(.X,IEN,1)
+8 SET PRV=+$ORDER(X(0))
End DoDot:1
+9 SET DATA=$PIECE($GET(^SC(+VSTR,0)),U,1,2)
+10 SET $PIECE(DATA,U,3)=$PIECE($GET(^DPT(DFN,.101)),U)
+11 SET $PIECE(DATA,U,4)=PRV
+12 SET $PIECE(DATA,U,5)=$PIECE($GET(^VA(200,PRV,0)),U)
+13 IF IEN>0
SET $PIECE(DATA,U,6)=IEN
SET $PIECE(DATA,U,7)=$PIECE($GET(^AUPNVSIT(IEN,150)),U)
SET $PIECE(DATA,U,8)=$$ISLOCKED(IEN)
+14 IF '$TEST
SET $PIECE(DATA,U,9)=$PIECE(IEN,U,2)
+15 QUIT
+16 ; RPC: Return location info
+17 ; Returns 0 node of HOSPITAL LOCATION file for specified entry.
LOCINFO(DATA,LOC) ;
+1 QUIT $GET(^SC(+LOC,0))
+2 ; Find a visit
+3 ; DFN = Patient IEN
+4 ; DAT = Visit date/time
+5 ; CAT = Service category
+6 ; LOC = Value to compare (location or stop code)
+7 ; CRE = Force create?
+8 ; PRV = Provider IEN to restrict search (optional)
+9 ; ELC = Encounter location (optional)
+10 ; Returns one of:
+11 ; If found or created: visit ien
+12 ; If not found: 0
+13 ; If error: -1^error message
FNDVIS(DFN,DAT,CAT,LOC,CRE,PRV,ELC) ;PEP - Find a visit
+1 NEW IN,OUT,IEN,DIF
+2 SET IN("PAT")=DFN
+3 SET IN("VISIT DATE")=DAT
+4 SET IN("VISIT TYPE")=$SELECT(CAT="E":"O",1:$SELECT($GET(DUZ("AG"))="I":$$GET1^DIQ(9001000,DUZ(2),.04,"I"),1:$$GET^XPAR("ALL","BEHOENCX VISIT TYPE")))
+5 SET IN("SRV CAT")=CAT
+6 SET IN("TIME RANGE")=60
+7 SET IN("USR")=DUZ
+8 IF $GET(LOC)
SET IN("HOS LOC")=LOC
+9 IF $GET(XQY)
SET IN("APCDOPT")=XQY
+10 IF $GET(PRV)
SET IN("PROVIDER")=PRV
+11 SET ELC=$GET(ELC)
+12 IF $LENGTH(ELC)
IF ELC'=+ELC
Begin DoDot:1
+13 SET IN("APCDOLOC")=ELC
+14 SET ELC=$$GET^XPAR("ALL","BEHOENCX OTHER LOCATION")
End DoDot:1
+15 SET IN("SITE")=$SELECT(ELC:ELC,$PIECE($GET(^SC(+$GET(LOC),0)),U,4):$PIECE(^(0),U,4),1:DUZ(2))
+16 IF 'CRE
SET IN("NEVER ADD")=1
+17 IF '$TEST
IF CRE<0
SET IN("FORCE ADD")=1
+18 IF $GET(DUZ("AG"))="I"
Begin DoDot:1
+19 DO GETVISIT^BSDAPI4(.IN,.OUT)
End DoDot:1
+20 IF '$TEST
DO GETVISIT^BEHOENC1(.IN,.OUT)
+21 IF 'OUT(0)
QUIT $SELECT(OUT(0)[U:"-1^"_$PIECE(OUT(0),U,2),1:0)
+22 SET IEN=0
SET DIF=999999
+23 FOR
SET IEN=$ORDER(OUT(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+24 IF OUT(IEN)="ADD"
Begin DoDot:2
+25 NEW VSTR
+26 SET VSTR=$$VIS2VSTR(DFN,IEN)
+27 DO BRDCAST^CIANBEVT("PCC."_DFN_".VST",VSTR)
+28 IF $GET(PRV)
DO UPDPRV(,DFN,VSTR,PRV)
End DoDot:2
+29 IF $$ABS(OUT(IEN))<DIF
SET DIF=$$ABS(OUT(IEN))
SET IEN(0)=IEN
End DoDot:1
+30 QUIT IEN(0)
+31 ; Return absolute value
ABS(X) QUIT $SELECT(X<0:-X,1:X)
+1 ; Return a visit ien from a visit string (create if necessary)
+2 ; DFN = Patient IEN
+3 ; VSTR = Visit string
+4 ; CREATE = Create flag
+5 ; 0 = Don't create
+6 ; >0 = Create if not found
+7 ; <0 = Always create
+8 ; PRV = Provider IEN to restrict visit search (optional)
VSTR2VIS(DFN,VSTR,CREATE,PRV) ;PEP - Convert visit string to visit IEN
+1 NEW IEN,DAT,CAT,LOC,FLG,VSIT,LP
+2 SET LOC=+VSTR
SET DAT=+$PIECE(VSTR,";",2)
SET CAT=$PIECE(VSTR,";",3)
SET IEN=+$PIECE(VSTR,";",4)
SET CREATE=+$GET(CREATE)
+3 IF 'IEN
IF CREATE'<0
SET IEN=$$FNDVIS(DFN,DAT,CAT,LOC,0,.PRV)
+4 IF 'IEN
IF CREATE'<0
SET IEN=$$FNDVIS(DFN,DAT,CAT,LOC,0)
+5 IF 'IEN
IF CREATE
SET IEN=$$FNDVIS(DFN,DAT,CAT,LOC,CREATE,.PRV)
+6 IF IEN>0
SET VSTR=$$VIS2VSTR(DFN,IEN,.IEN)
SET $PIECE(VSTR,";")=LOC
+7 QUIT IEN
+8 ; Return a visit string given visit ien
VIS2VSTR(DFN,IEN,ERR) ;PEP - Convert visit IEN to visit string
+1 NEW VSTR
+2 SET VSTR=$GET(^AUPNVSIT(+IEN,0))
+3 IF '$LENGTH(VSTR)
SET ERR="-1^Visit does not exist"
+4 IF '$TEST
IF $PIECE(VSTR,U,5)'=DFN
SET ERR="-1^Visit does not belong to current patient"
SET VSTR=""
+5 IF '$TEST
SET VSTR=$PIECE(VSTR,U,22)_";"_+VSTR_";"_$PIECE(VSTR,U,7)_";"_IEN
+6 QUIT VSTR
+7 ; RPC: Return a list of appointments
+8 ; APPTTIME^LOCIEN^LOCNAME^EXTSTATUS
APPTLST(DATA,DFN) ;EP
+1 NEW VASD,I
+2 SET VASD("F")=$$HTFM^XLFDT($HOROLOG-30,1)
+3 SET VASD("T")=$$HTFM^XLFDT($HOROLOG+1,1)_".2359"
+4 SET VASD("W")="123456789"
+5 DO SDA^VADPT
+6 SET I=0
+7 FOR
SET I=$ORDER(^UTILITY("VASD",$JOB,I))
IF 'I
QUIT
Begin DoDot:1
+8 SET DATA(I)=$PIECE(^UTILITY("VASD",$JOB,I,"I"),U,1,2)_U_$PIECE(^("E"),U,2,3)
End DoDot:1
+9 KILL ^UTILITY("VASD",$JOB)
+10 QUIT
+11 ; RPC: Return a list of admissions
+12 ; VSTR^LOCNAME^ADMDATE^TYPE^LOCKED
ADMITLST(DATA,DFN,BEG,END) ;EP
+1 NEW TIM,MOV,CNT,IDT,IDT2
+2 SET CNT=0
SET TIM=""
+3 IF '$GET(BEG)
SET BEG=2000000
+4 IF '$GET(END)
SET END=DT
+5 SET IDT2=9999999-(BEG\1)+.9
SET IDT=9999999-(END\1)
+6 FOR
IF 'IDT!(IDT>IDT2)
QUIT
Begin DoDot:1
+7 SET MOV=0
FOR
SET MOV=$ORDER(^DGPM("ATID1",DFN,IDT,MOV))
IF MOV'>0
QUIT
Begin DoDot:2
+8 SET X=$$ADMITINF(DFN,MOV)
+9 IF X
SET CNT=CNT+1
SET DATA(CNT)=X
End DoDot:2
End DoDot:1
SET IDT=$ORDER(^DGPM("ATID1",DFN,IDT))
+10 QUIT
+11 ; RPC: Return current admission info
+12 ; VSTR^LOCNAME^ADMDATE^TYPE^LOCKED
ADMITCUR(DATA,DFN) ;EP
+1 SET DATA=$$ADMITINF(DFN,+$GET(^DPT(DFN,.105)))
+2 QUIT
+3 ; Return admission info
+4 ; VSTR^LOCNAME^ADMDATE^TYPE^LOCKED
ADMITINF(DFN,MOV) ;EP
+1 NEW VIEN,VSTR,LLOC,XLOC,HLOC,CMOV,AMOV,DMOV,LMOV,MTIM,XTYP,X0
+2 SET X0=$GET(^DGPM(+MOV,0))
+3 IF $PIECE(X0,U,3)'=DFN
QUIT ""
+4 SET MTIM=$PIECE(X0,U)
SET DMOV=$PIECE(X0,U,17)
SET VIEN=$PIECE(X0,U,27)
+5 IF '$DATA(^AUPNVSIT(+VIEN,0))
SET VIEN=""
+6 SET CMOV=+$GET(^DPT(DFN,.102))
SET AMOV=+$GET(^(.105))
+7 SET XTYP=$PIECE($GET(^DG(405.1,+$PIECE(X0,U,4),0)),U)
+8 IF MOV=AMOV
IF CMOV'=AMOV
IF $DATA(^DGPM(CMOV,0))
SET LMOV=CMOV
+9 IF '$TEST
SET LMOV=MOV
+10 DO AL2(MOV,.XLOC,.HLOC)
IF LMOV'=MOV
DO AL2(LMOV,.LLOC,.HLOC)
+11 IF $LENGTH($GET(LLOC))
IF LLOC'=XLOC
SET XLOC=XLOC_" ("_LLOC_")"
+12 SET VSTR=HLOC_";"_MTIM_";H;"_VIEN
+13 QUIT VSTR_U_XLOC_U_MTIM_U_XTYP_U_$$ISLOCKED(VIEN)
+14 ; Return ward location name and associated hospital location ien for movement
AL2(MOV,WLOC,HLOC) ;
+1 SET WLOC=+$PIECE($GET(^DGPM(MOV,0)),U,6)
SET WLOC=$PIECE($GET(^DIC(42,WLOC,0)),U)
SET HLOC=+$GET(^(44))
+2 QUIT
+3 ; RPC: Get discharge movement information
DISCHRG(DATA,DFN,ADMITDT) ;EP
+1 NEW VAIP
+2 SET DATA=DT
+3 IF '$GET(ADMITDT)
QUIT
+4 SET VAIP("D")=ADMITDT
+5 DO 52^VADPT
+6 IF VAIP(17)
SET DATA=+VAIP(17,1)
+7 QUIT
+8 ; Returns true if active hospital location
+9 ; LOC = IEN of hospital location
+10 ; DAT = optional date to check (defaults to today)
ACTLOC(LOC,DAT) ;PEP - Is active location?
+1 NEW D0,X
+2 SET X=$GET(^SC(LOC,0))
+3 ; Screen nonexistent entries
IF '$LENGTH(X)
QUIT 0
+4 SET X=$PIECE($GET(^DG(40.8,+$PIECE(X,U,15),0)),U,7)
+5 ; Screen clinics not in current division
IF X
IF X'=DUZ(2)
QUIT 0
+6 ; Screen OOS entry
IF +$GET(^SC(LOC,"OOS"))
QUIT 0
+7 SET D0=+$GET(^SC(LOC,42))
SET DAT=$GET(DAT,DT)\1
+8 ; Check out of svc wards
IF D0
DO WIN^DGPMDDCF
QUIT 'X
+9 SET X=$GET(^SC(LOC,"I"))
+10 ; No inactivate date
IF 'X
QUIT 1
+11 ; Check reactivate date
IF DAT'<$PIECE(X,U)&($PIECE(X,U,2)=""!(DAT<$PIECE(X,U,2)))
QUIT 0
+12 ; Must still be active
QUIT 1
+13 ; RPC: Return a set of hospital locations
HOSPLOC(DATA,FROM,DIR,MAX,TYPE,START,END) ;EP
+1 NEW IEN,CNT,APT
+2 SET FROM=$GET(FROM)
SET DIR=$GET(DIR,1)
SET MAX=$GET(MAX,44)
SET TYPE=$GET(TYPE)
SET CNT=0
+3 SET START=$GET(START)\1
SET END=$GET(END)\1
+4 IF 'END
SET END=START
+5 FOR
SET FROM=$ORDER(^SC("B",FROM),DIR)
SET IEN=""
IF FROM=""
QUIT
Begin DoDot:1
+6 FOR
SET IEN=$ORDER(^SC("B",FROM,IEN),DIR)
IF 'IEN
QUIT
Begin DoDot:2
+7 IF $$ACTLOC(IEN)
IF $PIECE(^SC(IEN,0),U,3)[TYPE
Begin DoDot:3
+8 IF START
SET APT=$ORDER(^SC(IEN,"S",START-.1))\1
IF 'APT!(APT>END)
QUIT
+9 SET CNT=CNT+1
SET DATA(CNT)=IEN_U_$PIECE(^SC(IEN,0),U)_U_$SELECT($GET(DUZ("AG"))="I":$PIECE($GET(^BSDSC(IEN,0)),U,12),1:$PIECE($GET(^SC(IEN,0)),U,9))
End DoDot:3
End DoDot:2
End DoDot:1
IF CNT'<MAX
QUIT
+10 QUIT
+11 ; RPC: Return a set of clinics
CLINLOC(DATA,FROM,DIR,MAX,START,END) ;EP
+1 DO HOSPLOC(.DATA,.FROM,.DIR,.MAX,"C",.START,.END)
+2 QUIT
+3 ; RPC: Return a set of wards
INPLOC(DATA,FROM,DIR,MAX) ;EP
+1 DO HOSPLOC(.DATA,.FROM,.DIR,.MAX,"W")
+2 QUIT
+3 ; RPC: Return appts/visits for patient
+4 ; DFN = Patient IEN
+5 ; BEG = Beginning date to search (optional)
+6 ; Defaults to BEHOENCX SEARCH RANGE START
+7 ; END = Ending date to search (optional)
+8 ; Defaults to BEHOENCX SEARCH RANGE END
+9 ; LOC = If not specified, return all locations and all active appointments
+10 ; If <0, return all locations and all appointments (except checked-in)
+11 ; If >0, return only specified location and only active appointments
+12 ; SCEXC = Contains service category types to exclude (defaults to HXI)
+13 ; IGPFLG = Ignore pending check-in appointments
+14 ; .DATA= List of results in format:
+15 ; VSTR^LOCNAME^DATE^STATUS^LOCKED^PRV^PRVNM^STANDALONE
VISITLST(DATA,DFN,BEG,END,LOC,SCEXC,IGPFLG) ;EP
+1 NEW VAERR,VASD,CNT,IDT,IDT2,STS,DTM,LOCNAM,LOCIEN,VSTR,IEN,LP,XI,XE,X
+2 SET CNT=0
SET DATA=$$TMPGBL^CIAVMRPC
SET LOC=+$GET(LOC)
+3 ;p9 removed H, p12 removed I
SET SCEXC=$GET(SCEXC,"X")
+4 IF '$GET(BEG)
SET BEG=$$DTSTART
+5 IF '$GET(END)
SET END=$$DTSTOP+.9
+6 IF '$GET(IGPFLG)
SET IGPFLG=0
+7 ; Return list of visits for a patient
+8 SET IDT2=9999999-(BEG\1)+.9
SET IDT=9999999-(END\1)
+9 FOR
IF 'IDT!(IDT>IDT2)
QUIT
Begin DoDot:1
+10 FOR IEN=0:0
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,IDT,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+11 NEW PRV
+12 SET XI=$GET(^AUPNVSIT(IEN,0))
SET DTM=+XI
SET LOCIEN=$PIECE(XI,U,22)
SET LOCNAM=$PIECE($GET(^SC(+LOCIEN,0),"Unknown"),U)
SET X=$PIECE(XI,U,7)
+13 ; Ignore if logically deleted
IF $PIECE(XI,U,11)
QUIT
+14 IF 'LOC&'LOCIEN
QUIT
+15 IF LOC>0&(LOC'=LOCIEN)
QUIT
+16 DO GETPRV2(.PRV,IEN,1)
+17 SET PRV=$PIECE($GET(PRV(+$ORDER(PRV(0)))),U,1,2)
+18 SET VSTR=LOCIEN_";"_DTM_";"_X_";"_IEN
SET STS=$$SET^CIAU(X,$PIECE($GET(^DD(9000010,.07,0)),U,3))
+19 ;IHS/MSC/MGH p12 allow I visits with location
+20 IF X="I"&(+LOCIEN>0)
SET CNT=CNT+1
SET @DATA@(-DTM,CNT)=VSTR_U_LOCNAM_U_DTM_U_STS_U_$$ISLOCKED(IEN)_U_PRV_U_'$DATA(^SCE("AVSIT",IEN))
+21 IF '$TEST
IF SCEXC'[X
SET CNT=CNT+1
SET @DATA@(-DTM,CNT)=VSTR_U_LOCNAM_U_DTM_U_STS_U_$$ISLOCKED(IEN)_U_PRV_U_'$DATA(^SCE("AVSIT",IEN))
End DoDot:2
End DoDot:1
SET IDT=$ORDER(^AUPNVSIT("AA",DFN,IDT))
+22 IF LOC>0
QUIT
+23 IF IGPFLG>0
QUIT
+24 ; Get appointments pending check-in
+25 SET VASD("F")=$SELECT(LOC<0:BEG,BEG<DT:DT,1:BEG)
+26 SET VASD("T")=END
+27 SET VASD("W")=$SELECT(LOC<0:123456789,1:1)
+28 DO SDA^VADPT
+29 SET LP=0
+30 FOR
SET LP=$ORDER(^UTILITY("VASD",$JOB,LP))
IF 'LP
QUIT
Begin DoDot:1
+31 SET XI=^UTILITY("VASD",$JOB,LP,"I")
SET XE=^("E")
+32 SET DTM=$PIECE(XI,U)
SET LOCIEN=$PIECE(XI,U,2)
SET LOCNAM=$PIECE(XE,U,2)
+33 IF $$CHKDIN(DFN,LOCIEN,DTM)
QUIT
+34 SET XI=$GET(^DPT(DFN,"S",DTM,0))
+35 IF +XI'=LOCIEN
QUIT
+36 SET XI=$PIECE(XI,U,20)
SET STS=$SELECT(LOC<0:$PIECE(XE,U,3),1:"Pending Check-In")
+37 IF XI
IF $PIECE($GET(^SCE(XI,0)),U,5)
QUIT
+38 SET VSTR=LOCIEN_";"_DTM_";A"
+39 SET CNT=CNT+1
SET @DATA@(-DTM,CNT)=VSTR_U_LOCNAM_U_DTM_U_STS
End DoDot:1
+40 KILL ^UTILITY("VASD",$JOB)
+41 QUIT
+42 ; Returns true if checked in
CHKDIN(DFN,LOCIEN,DTM) ;
+1 IF $GET(DUZ("AG"))="I"
QUIT $$CI^BSDU2(DFN,LOCIEN,DTM)
+2 QUIT ''$PIECE($$STATUS^SDAMA308(DFN,DTM,LOCIEN),";",4)
+3 ; Returns visit lock status:
+4 ; -1: Visit not found
+5 ; 0: Visit is not locked
+6 ; 1: Visit is locked
ISLOCKED(IEN) ;PEP - Is visit locked?
+1 NEW DAT,DAYS,EXPDT
+2 SET DAT=$$VISREFDT(IEN)
+3 IF 'DAT
QUIT -1
+4 ;IHS/MSC/PLS - 02/18/09 - Parameter now holds lock expiration date
+5 SET EXPDT=$$GET^XPAR("USR","BEHOENCX VISIT LOCK OVERRIDE","`"_IEN)
+6 IF EXPDT'<$$DT^XLFDT()
QUIT 0
+7 ; remove expired locked
IF EXPDT
DO DEL^XPAR("USR","BEHOENCX VISIT LOCK OVERRIDE","`"_IEN)
+8 ;Q:$$GET^XPAR("USR","BEHOENCX VISIT LOCK OVERRIDE","`"_IEN) 0
+9 SET DAYS=$$GET^XPAR("ALL","BEHOENCX VISIT LOCKED")
+10 QUIT $$FMDIFF^XLFDT(DT,DAT)>$SELECT(DAYS<1:1,1:DAYS)
+11 ; Returns reference date for visit lock check
VISREFDT(IEN) ;
+1 NEW ADM,DIS,DAT
+2 SET DAT=$PIECE($GET(^AUPNVSIT(+IEN,0)),U,2)
+3 IF 'DAT
QUIT ""
+4 SET ADM=$ORDER(^DGPM("AVISIT",IEN,0))
+5 IF 'ADM
QUIT DAT
+6 SET DIS=$PIECE($GET(^DGPM(ADM,0)),U,17)
+7 QUIT $SELECT(DIS:$PIECE($GET(^DGPM(DIS,0)),U),1:DT)
+8 ; RPC: Return providers associated with a visit (by VSTR)
+9 ; If PRI is set, returns primary only
+10 ; Returns as DATA(DUZ)=DUZ^Name^Primary^EncDT
GETPRV(DATA,DFN,VSTR,PRI) ;EP
+1 DO GETPRV2(.DATA,$$VSTR2VIS(DFN,VSTR,0),.PRI)
+2 QUIT
+3 ; RPC: Return providers associated with a visit (by IEN)
+4 ; If PRI is set, returns primary only
+5 ; Returns as DATA(DUZ)=DUZ^Name^Primary^EncDT
GETPRV2(DATA,IEN,PRI) ;EP
+1 NEW LP,ED,PP,PR,X
+2 KILL DATA
+3 SET LP=0
SET IEN=+IEN
SET PRI=+$GET(PRI)
+4 FOR
SET LP=$ORDER(^AUPNVPRV("AD",IEN,LP))
IF 'LP
QUIT
Begin DoDot:1
+5 SET X=$GET(^AUPNVPRV(LP,0))
SET ED=$PIECE($GET(^(12)),U)
SET PP=$PIECE(X,U,4)="P"
SET PR=+X
+6 IF $PIECE(X,U,3)=IEN
IF 'PRI!PP
SET DATA(PR)=PR_U_$$GET1^DIQ(200,PR,.01)_U_PP_U_ED
End DoDot:1
+7 QUIT
+8 ; RPC: Add/Remove providers to/from a visit
UPDPRV(DATA,DFN,VSTR,PRV) ;EP
+1 NEW PCC,ACT,PRI,PFG,RTN
+2 IF $DATA(PRV)=1
SET PRV(PRV)="P"
+3 SET PRV=""
SET PFG=0
+4 FOR
SET PRV=$ORDER(PRV(PRV))
IF '$LENGTH(PRV)
QUIT
Begin DoDot:1
+5 SET ACT=PRV(PRV)
SET PRI=0
+6 IF ACT="P"
SET PRI='PFG
SET ACT="+"
SET PFG=1
+7 DO ADDPCC("PRV"_ACT_U_PRV_"^^^^"_PRI)
End DoDot:1
+8 IF $DATA(PCC)
DO SAVE^BEHOENPC(.DATA,.PCC)
+9 QUIT
+10 ; RPC: Check visit for missing elements
CHKVISIT(DATA,IEN) ;
+1 IF $TEXT(+2^BEHOXQPC)=""
QUIT
+2 NEW RTN,CNT
+3 SET CNT=0
+4 DO NOPOV^BEHOXQPC(.RTN,IEN)
DO CV1("POV")
+5 DO NOEMC^BEHOXQPC(.RTN,IEN)
DO CV1("E&M")
+6 QUIT
CV1(DX) IF $DATA(RTN)
SET CNT=CNT+1
SET $PIECE(RTN,U)=DX
SET DATA(CNT)=RTN
+1 KILL RTN
+2 QUIT
+3 ; Build PCC array
ADDPCC(X) ;
+1 IF '$DATA(PCC)
SET PCC(1)="HDR^^^"_VSTR
SET PCC(2)="VST^PT^"_DFN
+2 SET PCC($ORDER(PCC(""),-1)+1)=X
+3 QUIT
+4 ; VST may either be the visit ien or a visitstr
+5 ; Optionally returns success indicator
SETCTX(VST) ;PEP - Set the encounter context
+1 NEW UID
+2 SET UID=$$GETUID^CIANBUTL
+3 IF $LENGTH(UID)
DO QUEUE^CIANBEVT("CONTEXT.ENCOUNTER",VST,UID)
+4 IF $QUIT
QUIT ''$LENGTH(UID)
+5 QUIT
+6 ; Return FM date given relative date
+7 ; DAT = Relative date (e.g., T+1)
+8 ; DFL = Default relative date (if DAT is not specified)
TOFM(DAT,DFL) ;
+1 NEW %DT,X,Y
+2 SET X=$SELECT(DAT="":DFL,1:DAT)
SET %DT="TS"
+3 DO ^%DT
+4 QUIT Y
+5 ; Return start date for encounters
DTSTART() ;EP
+1 QUIT $$TOFM($$GET^XPAR("ALL","BEHOENCX SEARCH RANGE START",1,"I"),"T-365")
+2 ; Return stop date for encounters
DTSTOP() ;EP
+1 QUIT $$TOFM($$GET^XPAR("ALL","BEHOENCX SEARCH RANGE STOP",1,"I"),"T+90")
+2 ; Return formatted visit detail report
ENINQ(DATA,VIEN) ;
+1 SET DATA=$$TMPGBL^CIAVMRPC
+2 DO CAPTURE^CIAUHFS($TRANSLATE($$GET^XPAR($$ENT^CIAVMRPC("BEHOENCX DETAIL REPORT"),"BEHOENCX DETAIL REPORT"),"~",U),DATA,80)
+3 QUIT
+4 ; Return boolean value represent if location is linked to stop code.
ISSTOPCD(DATA,LOCIEN,STOPCODE) ;EP-
+1 SET DATA=$$GET1^DIQ(40.7,$$GET1^DIQ(44,LOCIEN,8,"I"),1)=STOPCODE
+2 QUIT
