BTIUVSIT ; IHS/ITSC/LJF - Visit File look-up ;18-Jul-2012 13:36;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1001,1010**;NOV 04, 2004;Build 24
; IHS version of TIUVSIT calls
; IHS/MSC/MGH Patch 10 added GUI visit creation call
;
FINDVST ;EP; -- IHS setup code to find visit for note
;IHS/MSC/MGH new code for patch 10
N VIEN
I '+TIUMODE D S BTIUQ=1
.S TIUY("LOC")=VLOC_U_$P($G(^SC(VLOC,0)),U,1)
.I $G(TIUY("LOC"))="",+DUZ D
..N TIUPREF,IDX
..S TIUPREF=$$PERSPRF^TIULE(DUZ)
..S IDX=+$P(TIUPREF,U,2)
..I IDX S TIUY("LOC")=IDX_U_$P($G(^SC(IDX,0)),U,1) ; DBIA/ICR 10040
.S VIEN=$$FNDVIS^BEHOENCX(DFN,TIUVDT,TIUCAT,TIULOC,-1,,"")
.I +VIEN S TIU("VISIT")=VIEN
;End IHS mods
K ^TMP("TIUIHSV",$J)
; -- find possible visits for patient and date
I '$D(^TMP("TIUVN",$J)) D GETAPPT(DFN,$G(TIULOC),$G(TIUOCC),$G(TIULDT),"",.TIULAST,$G(TIUVDT))
; -- if none found, set quit variable
I '$D(^TMP("TIUVNI",$J)) S BTIUQ=1 Q
; -- if not interactive mode and >1 found, set quit variable
I '+TIUMODE,$O(^TMP("TIUVNI",$J,+$O(^TMP("TIUVNI",$J,0))))]"" S BTIUQ=1
Q
;
GETAPPT(DFN,CLINIC,OCCLIM,INDEX,COUNT,LAST,EARLY) ;EP; Get list of visits
; -- changed list from list of appts to list of visits
; TIUMODE=1 for interactive user mode; =0 for background
NEW TIUCNT,TIUI,TIUSREC,TIUJ,TIUEND
;
; go back 20 visits or 100 if med records user
S OCCLIM=$S(+$G(OCCLIM):+$G(OCCLIM),$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION"):100,1:20)
;
; get starting and ending dates
S:'+$G(DT) DT=+$P($$NOW^TIULC,".")
S EARLY=9999999.9999999-+$G(EARLY)
S TIUI=9999999.9999999-$S(+$G(INDEX):+$G(INDEX)+1,1:DT+1)
S (LAST,TIUCNT)=0,TIUJ=$S(+$G(COUNT):+$G(COUNT),1:0)
;
; loop through visit file for patient and date
F S TIUI=$O(^AUPNVSIT("AA",DFN,TIUI)) S:'TIUI LAST=1 Q:'TIUI!(TIUCNT'<OCCLIM)!(TIUI>EARLY) D
. S TIUZV=0 F S TIUZV=$O(^AUPNVSIT("AA",DFN,TIUI,TIUZV)) Q:'TIUZV D
.. NEW X,TIUZ
.. D ENP^XBDIQ1(9000010,TIUZV,".01;.06:.08;.11;.22","TIUZ(","I")
.. ;
.. ; try to match service category, clinic and author
.. S X=TIUZ(.07,"I") ;service category
.. ;
.. ;IHS/ITSC/LJF 01/05/2005 PATCH 1001 check hosp loc or clinic code
.. ;I '$G(CLINIC),X'="H",$G(TIUAUTH)]"" S CLINIC=$$GETCLN
.. ;I '$G(CLINIC),'TIUMODE,X'="H" Q
.. ;I +$G(CLINIC),(+TIUZ(.08,"I")'=+CLINIC),X'="H" Q
.. I $G(CLINIC),(+TIUZ(.22,"I"))'=+CLINIC Q ;if hosp loc sent, check it
.. ; else check if clinic code sent or defined for title or provider, check it
.. I '$G(CLINIC),X'="H",$G(TIUAUTH)]"" NEW STOP S STOP=0 D Q:STOP
... S CLINIC=$$GETCLN
... I '$G(CLINIC),'TIUMODE,X'="H" S STOP=1 Q
... I +$G(CLINIC),(+TIUZ(.08,"I")'=+CLINIC),X'="H" S STOP=1
.. ;IHS/ITSC/LJF 01/05/2005 end of PATCH 1001 changes
.. ;
.. S TIUCNT=+$G(TIUCNT)+1,TIUJ=+$G(TIUJ)+1
.. I $G(CLINIC),X'="H",TIUZ(.01,"I")\1=$$IDATE^TIULC(TIUVDT) S TIUCNT=OCCLIM ;if exact match found with clinic, stop looking
.. ;
.. S ^TMP("TIUVNI",$J,TIUJ)=TIUZ(.01,"I")_U_+TIUZ(.22,"I")_U_TIUZ(.07,"I")
.. S ^TMP("TIUVN",$J,TIUJ)=TIUZ(.01)_U_TIUZ(.22)_U_TIUZ(.07)_U_TIUZ(.08)_U_$$PROV(TIUZV)_U_$$GET1^DIQ(9999999.06,+TIUZ(.06,"I"),.08)
.. S ^TMP("TIUVDT",$J,TIUZ(.01,"I"))=TIUJ,^TMP("TIUIHSV",$J,TIUJ)=TIUZV
;
I '$D(^TMP("TIUVNI",$J)) D
. S Y=$$INPT(DFN,EARLY) I +Y D SETINPT($P(Y,U,2)) Q
. I TIUMODE D
.. S Y=$$READ^TIUU("Y","No visits for patient. Okay to add one","YES") Q:'Y
.. D ADD(DFN,$S($D(TIUHDR):$G(TIUVDT),1:EARLY),$G(TIUCLNC))
Q
;
GETSURG(VISIT,DFN,HRCN,SRGDT,CLINIC) ;EP; Get list of surgeries
; -- also called by TIUPUTPN
N TIUI,TIUX,TIUZ
S DFN=+$$PATIENT^TIULA($G(TIUSSN)) I 'DFN Q
S (TIUI,TIUX)=0
F S TIUI=$O(^SRF("AIHS4",SRGDT,DFN,TIUI)) Q:'TIUI D
. S TIUX=$$GET1^DIQ(130,TIUI,9999999.01,"I")
. I TIUX S TIUZ(TIUX)="" Q
S VISIT=$O(TIUZ(0)) I $O(TIUZ(VISIT)) S VISIT=0 ;>1 surgery on date
I VISIT<1 S VISIT=0
Q
;
HELP(X) ;EP; Offer help
D MSG(" Indicate the visit with which the document is associated, by",2,0,0)
D MSG(" choosing the corresponding number. To VIEW a visit to insure",1,0,0)
D MSG(" it is the correct one, type ""V"" plus the item # (i.e. V5).",1,0,0)
D MSG(" To add a NEW visit type ""N"". For MORE, older visits (beyond",1,0,0)
D MSG(" the 20 most recent) enter ""M"".",1,2,0)
Q
;
MSG(A,B,C,D) ; -- display line to screen
D MSG^BTIUU(A,B,C,D)
Q
;
ADD(DFN,ASK,TIUCLNC) ;EP; Add a visit for patient
N VSIT,VTYPE,TIUY,DA,DIE,DR,X,Y,DEFAULT,QUES,TIUZ
;
; if visit date in header, TIUHDR array is set
I $D(TIUHDR) N APCDHL
;
; set service category; use other routine if event selected
S APCDCAT=$$READ^TIUU("S^A:AMBULATORY;I:IN-HOSPITAL;T:TELEPHONE CALL;C:CHART REVIEW;E:EVENT","Service Category","C"),APCDCAT=$E(APCDCAT)
I APCDCAT="" S TIUER=1 Q
I APCDCAT="E" S APCDVSIT=$$ADDEVNT^BTIUCHLP(DFN) D VSTSET Q
;
; set location, type & patient for visit
D VISITSET Q:'APCDLOC
;
; get visit date
S DEFAULT="NOW"
I $D(TIUHDR) D
. W !!?2,"*Visit Date in Header: ",$G(TIUHDR("TIUVDT"))
. W "* Remember to add time",!
. S DEFAULT=""
S APCDDATE=+$$READ^TIUU("D^::ERX","Visit Date & Time",DEFAULT)
I +APCDDATE'>0 S TIUER=1 Q
;
; ask for clinic name
S APCDHL=+$$SELLOC^TIUVSIT
I APCDHL<1 S TIUER=1 Q
;
; ask clinic code
S APCDCLN=+$$READ^TIUU("PO^40.7:EMQ","Clinic Code",$$GET1^DIQ(40.7,+$$GET1^DIQ(44,APCDHL,8,"I"),1))
I APCDCAT="I",APCDCLN<1 K APCDCLN
;
; create visit
D EN^APCDALV ;calling PEP in PCC
;
; set TIU variables after visit created or selected
VSTSET I '$G(APCDVSIT) S TIUER=1 Q
D MSG^BTIUU("**Visit Created!**",2,1,1)
D ENP^XBDIQ1(9000010,APCDVSIT,".01;.06:.08;.11;.22","TIUZ(","I")
; set array with internal format for visit data
S ^TMP("TIUVNI",$J,1)=TIUZ(.01,"I")_U_+TIUZ(.22,"I")_U_TIUZ(.07,"I")
; set array with external format for visit date
S ^TMP("TIUVN",$J,1)=TIUZ(.01)_U_TIUZ(.22)_U_TIUZ(.07)_U_TIUZ(.08)_U_$$PROV(APCDVSIT)_U_$$GET1^DIQ(9999999.06,+TIUZ(.06,"I"),.08)
; set array with visit ien
S ^TMP("TIUVDT",$J,TIUZ(.01,"I"))=1,^TMP("TIUIHSV",$J,1)=APCDVSIT
; set string with clinic, date and service category; used by VA rtns
S VSTR=+TIUZ(.22,"I")_";"_+TIUZ(.01,"I")_";"_TIUZ(.07,"I")
; if hosp loc (clinic name) is set, TIUSDC=clinic code^amis stop code
I +$G(APCDHL),$P($G(^SC(+APCDHL,0)),U,3)'="W" D
. S TIUSDC=+$P($G(^SC(+APCDHL,0)),U,7)_U_$P($G(^DIC(40.7,+$P($G(^SC(+APCDHL,0)),U,7),0)),U,2)
;
; made it this far, set a-okay variables
S TIUER=0,TIUOK=1
Q
;
STUFVST(DFN,VDATE,APCDCLN) ; -- auto-add of visit if not found
Q
N VSIT,VTYPE,TIUY,DA,DIE,DR,X,Y,DEFAULT,QUES,TIUZ
S APCDCAT=$$READ^TIUU("S^A:AMBULATORY;I:IN-HOSPITAL;T:TELEPHONE CALL;C:CHART REVIEW","Service Category","A"),APCDCAT=$E(APCDCAT)
I APCDCAT="" S TIUER=1 Q
D VISITSET Q:'APCDLOC ; set standard visit variables
W !!?2,"*Visit Date in Header: ",$G(TIUHDR("TIUVDT")),"* Remember to add time",!
S APCDDATE=+$$READ^TIUU("D^::ERX","Visit Date & Time")
I +APCDDATE'>0 S TIUER=1 Q
S APCDCLN=+$$READ^TIUU("PO^40.7:EMQ","Clinic Code",$G(APCDCLN))
I APCDCAT="I",APCDCLN<1 K APCDCLN
;
; -- create visit
D ^APCDALV I 'APCDVSIT S TIUER=1 Q
D MSG^BTIUU("**Visit Created!**",2,1,1)
D ENP^XBDIQ1(9000010,APCDVSIT,".01;.06:.08;.11;.22","TIUZ(","I")
S ^TMP("TIUVNI",$J,1)=TIUZ(.01,"I")_U_+TIUZ(.22,"I")_U_TIUZ(.07,"I")
S ^TMP("TIUVN",$J,1)=TIUZ(.01)_U_TIUZ(.22)_U_TIUZ(.07)_U_TIUZ(.08)_U_$$PROV(APCDVSIT)_U_$$GET1^DIQ(9999999.06,+TIUZ(.06,"I"),.08)
S ^TMP("TIUVDT",$J,TIUZ(.01,"I"))=1,^TMP("TIUIHSV",$J,1)=APCDVSIT
;
I +$G(APCDHL),$P($G(^SC(+APCDHL,0)),U,3)'="W" D
. S TIUSDC=+$P($G(^SC(+APCDHL,0)),U,7)_U_$P($G(^DIC(40.7,+$P($G(^SC(+APCDHL,0)),U,7),0)),U,2)
S TIUER=0
Q
;
VISITSET ; -- sets visit variables
; -- pre-answer some questions
S APCDLOC=$G(DUZ(2)) ; location
I 'APCDLOC!'$D(^APCDSITE(+APCDLOC)) S APCDLOC=$O(^APCCCTRL(0))
Q:'APCDLOC
S APCDTYPE=$$GET1^DIQ(9001001.2,APCDLOC,.11,"I") ;type of visit
S APCDPAT=+DFN ;patient
Q
;
;
INPT(DFN,VDATE) ; -- return 1 if patient was inpatient on this date
NEW LASTA,VISIT,DSCH
S LASTA=$O(^AUPNVSIT("AAH",DFN,VDATE)) I LASTA="" Q 0 ;no admits
S VISIT=$O(^AUPNVSIT("AAH",DFN,LASTA,0)) I VISIT="" Q 0 ;bad xref
I '$D(^AUPNVINP("AD",VISIT)) Q 1_U_VISIT ;still inpt
S DSCH=+$G(^AUPNVINP(+$O(^AUPNVINP("AD",VISIT,0)),0))
I DSCH<(9999999.9999999-VDATE) Q 0 ;already dsch
Q 1_U_VISIT
;
SETINPT(VISIT) ; -- set ^tmp for hospitalization
NEW TIUZ,REVDT
D ENP^XBDIQ1(9000010,VISIT,".01;.07;.08","TIUZ(","I")
S REVDT=9999999.9999999-TIUZ(.01,"I")
S ^TMP("TIUVNI",$J,1)=REVDT_U_+TIUZ(.08,"I")_U_TIUZ(.07,"I")
S ^TMP("TIUVN",$J,1)=TIUZ(.01)_U_TIUZ(.08)_U_TIUZ(.07)
S ^TMP("TIUVDT",$J,REVDT)=1,^TMP("TIUIHSV",$J,1)=VISIT
Q
;
PROV(V) ;EP; -- returns primary provider for visit
NEW X,Y
S X=0 F S X=$O(^AUPNVPRV("AD",V,X)) Q:'X!($D(Y)) D
. I $P(^AUPNVPRV(X,0),U,4)'="P" Q
. S Y=$$GET1^DIQ($S($P(^DD(9000010.06,.01,0),U,2)[200:200,1:6),+^AUPNVPRV(X,0),.01)
Q $E($G(Y),1,15)
;
GETCLN() ; -- returns clinic code ien for dictator if defined
I $G(TIUCLNC) S X=$O(^DIC(40.7,"C",TIUCLNC,0)) I X Q X ;IHS/ITSC/LJF 01/05/2005 PATCH 1001
NEW X,Y,DIC,USR,CODE,TIUCLNC
; -- does title have clinic code?
S Y=$O(^TIU(8925.1,+$G(TIUTYPE),"HEAD","E","TIUCLNC",0))
I Y S CODE=$G(^TIU(8925.1,+TIUTYPE,"HEAD",Y,1))
I $G(CODE)]"" X CODE
I $G(TIUCLNC) S X=$O(^DIC(40.7,"C",TIUCLNC,0)) I X Q X
;
; -- does author have clinic code?
S X=$$INAME^TIULS(TIUAUTH),DIC=200,DIC(0)="M" D ^DIC I Y<1 Q ""
S USR=0 F S USR=$O(^USR(8930.3,"B",+Y,USR)) Q:'USR!($G(CODE)) D
. S CODE=$$GET1^DIQ(8930.3,USR,9999999.02,"I")
Q $G(CODE)
BTIUVSIT ; IHS/ITSC/LJF - Visit File look-up ;18-Jul-2012 13:36;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1001,1010**;NOV 04, 2004;Build 24
+2 ; IHS version of TIUVSIT calls
+3 ; IHS/MSC/MGH Patch 10 added GUI visit creation call
+4 ;
FINDVST ;EP; -- IHS setup code to find visit for note
+1 ;IHS/MSC/MGH new code for patch 10
+2 NEW VIEN
+3 IF '+TIUMODE
Begin DoDot:1
+4 SET TIUY("LOC")=VLOC_U_$PIECE($GET(^SC(VLOC,0)),U,1)
+5 IF $GET(TIUY("LOC"))=""
IF +DUZ
Begin DoDot:2
+6 NEW TIUPREF,IDX
+7 SET TIUPREF=$$PERSPRF^TIULE(DUZ)
+8 SET IDX=+$PIECE(TIUPREF,U,2)
+9 ; DBIA/ICR 10040
IF IDX
SET TIUY("LOC")=IDX_U_$PIECE($GET(^SC(IDX,0)),U,1)
End DoDot:2
+10 SET VIEN=$$FNDVIS^BEHOENCX(DFN,TIUVDT,TIUCAT,TIULOC,-1,,"")
+11 IF +VIEN
SET TIU("VISIT")=VIEN
End DoDot:1
SET BTIUQ=1
+12 ;End IHS mods
+13 KILL ^TMP("TIUIHSV",$JOB)
+14 ; -- find possible visits for patient and date
+15 IF '$DATA(^TMP("TIUVN",$JOB))
DO GETAPPT(DFN,$GET(TIULOC),$GET(TIUOCC),$GET(TIULDT),"",.TIULAST,$GET(TIUVDT))
+16 ; -- if none found, set quit variable
+17 IF '$DATA(^TMP("TIUVNI",$JOB))
SET BTIUQ=1
QUIT
+18 ; -- if not interactive mode and >1 found, set quit variable
+19 IF '+TIUMODE
IF $ORDER(^TMP("TIUVNI",$JOB,+$ORDER(^TMP("TIUVNI",$JOB,0))))]""
SET BTIUQ=1
+20 QUIT
+21 ;
GETAPPT(DFN,CLINIC,OCCLIM,INDEX,COUNT,LAST,EARLY) ;EP; Get list of visits
+1 ; -- changed list from list of appts to list of visits
+2 ; TIUMODE=1 for interactive user mode; =0 for background
+3 NEW TIUCNT,TIUI,TIUSREC,TIUJ,TIUEND
+4 ;
+5 ; go back 20 visits or 100 if med records user
+6 SET OCCLIM=$SELECT(+$GET(OCCLIM):+$GET(OCCLIM),$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION"):100,1:20)
+7 ;
+8 ; get starting and ending dates
+9 IF '+$GET(DT)
SET DT=+$PIECE($$NOW^TIULC,".")
+10 SET EARLY=9999999.9999999-+$GET(EARLY)
+11 SET TIUI=9999999.9999999-$SELECT(+$GET(INDEX):+$GET(INDEX)+1,1:DT+1)
+12 SET (LAST,TIUCNT)=0
SET TIUJ=$SELECT(+$GET(COUNT):+$GET(COUNT),1:0)
+13 ;
+14 ; loop through visit file for patient and date
+15 FOR
SET TIUI=$ORDER(^AUPNVSIT("AA",DFN,TIUI))
IF 'TIUI
SET LAST=1
IF 'TIUI!(TIUCNT'<OCCLIM)!(TIUI>EARLY)
QUIT
Begin DoDot:1
+16 SET TIUZV=0
FOR
SET TIUZV=$ORDER(^AUPNVSIT("AA",DFN,TIUI,TIUZV))
IF 'TIUZV
QUIT
Begin DoDot:2
+17 NEW X,TIUZ
+18 DO ENP^XBDIQ1(9000010,TIUZV,".01;.06:.08;.11;.22","TIUZ(","I")
+19 ;
+20 ; try to match service category, clinic and author
+21 ;service category
SET X=TIUZ(.07,"I")
+22 ;
+23 ;IHS/ITSC/LJF 01/05/2005 PATCH 1001 check hosp loc or clinic code
+24 ;I '$G(CLINIC),X'="H",$G(TIUAUTH)]"" S CLINIC=$$GETCLN
+25 ;I '$G(CLINIC),'TIUMODE,X'="H" Q
+26 ;I +$G(CLINIC),(+TIUZ(.08,"I")'=+CLINIC),X'="H" Q
+27 ;if hosp loc sent, check it
IF $GET(CLINIC)
IF (+TIUZ(.22,"I"))'=+CLINIC
QUIT
+28 ; else check if clinic code sent or defined for title or provider, check it
+29 IF '$GET(CLINIC)
IF X'="H"
IF $GET(TIUAUTH)]""
NEW STOP
SET STOP=0
Begin DoDot:3
+30 SET CLINIC=$$GETCLN
+31 IF '$GET(CLINIC)
IF 'TIUMODE
IF X'="H"
SET STOP=1
QUIT
+32 IF +$GET(CLINIC)
IF (+TIUZ(.08,"I")'=+CLINIC)
IF X'="H"
SET STOP=1
End DoDot:3
IF STOP
QUIT
+33 ;IHS/ITSC/LJF 01/05/2005 end of PATCH 1001 changes
+34 ;
+35 SET TIUCNT=+$GET(TIUCNT)+1
SET TIUJ=+$GET(TIUJ)+1
+36 ;if exact match found with clinic, stop looking
IF $GET(CLINIC)
IF X'="H"
IF TIUZ(.01,"I")\1=$$IDATE^TIULC(TIUVDT)
SET TIUCNT=OCCLIM
+37 ;
+38 SET ^TMP("TIUVNI",$JOB,TIUJ)=TIUZ(.01,"I")_U_+TIUZ(.22,"I")_U_TIUZ(.07,"I")
+39 SET ^TMP("TIUVN",$JOB,TIUJ)=TIUZ(.01)_U_TIUZ(.22)_U_TIUZ(.07)_U_TIUZ(.08)_U_$$PROV(TIUZV)_U_$$GET1^DIQ(9999999.06,+TIUZ(.06,"I"),.08)
+40 SET ^TMP("TIUVDT",$JOB,TIUZ(.01,"I"))=TIUJ
SET ^TMP("TIUIHSV",$JOB,TIUJ)=TIUZV
End DoDot:2
End DoDot:1
+41 ;
+42 IF '$DATA(^TMP("TIUVNI",$JOB))
Begin DoDot:1
+43 SET Y=$$INPT(DFN,EARLY)
IF +Y
DO SETINPT($PIECE(Y,U,2))
QUIT
+44 IF TIUMODE
Begin DoDot:2
+45 SET Y=$$READ^TIUU("Y","No visits for patient. Okay to add one","YES")
IF 'Y
QUIT
+46 DO ADD(DFN,$SELECT($DATA(TIUHDR):$GET(TIUVDT),1:EARLY),$GET(TIUCLNC))
End DoDot:2
End DoDot:1
+47 QUIT
+48 ;
GETSURG(VISIT,DFN,HRCN,SRGDT,CLINIC) ;EP; Get list of surgeries
+1 ; -- also called by TIUPUTPN
+2 NEW TIUI,TIUX,TIUZ
+3 SET DFN=+$$PATIENT^TIULA($GET(TIUSSN))
IF 'DFN
QUIT
+4 SET (TIUI,TIUX)=0
+5 FOR
SET TIUI=$ORDER(^SRF("AIHS4",SRGDT,DFN,TIUI))
IF 'TIUI
QUIT
Begin DoDot:1
+6 SET TIUX=$$GET1^DIQ(130,TIUI,9999999.01,"I")
+7 IF TIUX
SET TIUZ(TIUX)=""
QUIT
End DoDot:1
+8 ;>1 surgery on date
SET VISIT=$ORDER(TIUZ(0))
IF $ORDER(TIUZ(VISIT))
SET VISIT=0
+9 IF VISIT<1
SET VISIT=0
+10 QUIT
+11 ;
HELP(X) ;EP; Offer help
+1 DO MSG(" Indicate the visit with which the document is associated, by",2,0,0)
+2 DO MSG(" choosing the corresponding number. To VIEW a visit to insure",1,0,0)
+3 DO MSG(" it is the correct one, type ""V"" plus the item # (i.e. V5).",1,0,0)
+4 DO MSG(" To add a NEW visit type ""N"". For MORE, older visits (beyond",1,0,0)
+5 DO MSG(" the 20 most recent) enter ""M"".",1,2,0)
+6 QUIT
+7 ;
MSG(A,B,C,D) ; -- display line to screen
+1 DO MSG^BTIUU(A,B,C,D)
+2 QUIT
+3 ;
ADD(DFN,ASK,TIUCLNC) ;EP; Add a visit for patient
+1 NEW VSIT,VTYPE,TIUY,DA,DIE,DR,X,Y,DEFAULT,QUES,TIUZ
+2 ;
+3 ; if visit date in header, TIUHDR array is set
+4 IF $DATA(TIUHDR)
NEW APCDHL
+5 ;
+6 ; set service category; use other routine if event selected
+7 SET APCDCAT=$$READ^TIUU("S^A:AMBULATORY;I:IN-HOSPITAL;T:TELEPHONE CALL;C:CHART REVIEW;E:EVENT","Service Category","C")
SET APCDCAT=$EXTRACT(APCDCAT)
+8 IF APCDCAT=""
SET TIUER=1
QUIT
+9 IF APCDCAT="E"
SET APCDVSIT=$$ADDEVNT^BTIUCHLP(DFN)
DO VSTSET
QUIT
+10 ;
+11 ; set location, type & patient for visit
+12 DO VISITSET
IF 'APCDLOC
QUIT
+13 ;
+14 ; get visit date
+15 SET DEFAULT="NOW"
+16 IF $DATA(TIUHDR)
Begin DoDot:1
+17 WRITE !!?2,"*Visit Date in Header: ",$GET(TIUHDR("TIUVDT"))
+18 WRITE "* Remember to add time",!
+19 SET DEFAULT=""
End DoDot:1
+20 SET APCDDATE=+$$READ^TIUU("D^::ERX","Visit Date & Time",DEFAULT)
+21 IF +APCDDATE'>0
SET TIUER=1
QUIT
+22 ;
+23 ; ask for clinic name
+24 SET APCDHL=+$$SELLOC^TIUVSIT
+25 IF APCDHL<1
SET TIUER=1
QUIT
+26 ;
+27 ; ask clinic code
+28 SET APCDCLN=+$$READ^TIUU("PO^40.7:EMQ","Clinic Code",$$GET1^DIQ(40.7,+$$GET1^DIQ(44,APCDHL,8,"I"),1))
+29 IF APCDCAT="I"
IF APCDCLN<1
KILL APCDCLN
+30 ;
+31 ; create visit
+32 ;calling PEP in PCC
DO EN^APCDALV
+33 ;
+34 ; set TIU variables after visit created or selected
VSTSET IF '$GET(APCDVSIT)
SET TIUER=1
QUIT
+1 DO MSG^BTIUU("**Visit Created!**",2,1,1)
+2 DO ENP^XBDIQ1(9000010,APCDVSIT,".01;.06:.08;.11;.22","TIUZ(","I")
+3 ; set array with internal format for visit data
+4 SET ^TMP("TIUVNI",$JOB,1)=TIUZ(.01,"I")_U_+TIUZ(.22,"I")_U_TIUZ(.07,"I")
+5 ; set array with external format for visit date
+6 SET ^TMP("TIUVN",$JOB,1)=TIUZ(.01)_U_TIUZ(.22)_U_TIUZ(.07)_U_TIUZ(.08)_U_$$PROV(APCDVSIT)_U_$$GET1^DIQ(9999999.06,+TIUZ(.06,"I"),.08)
+7 ; set array with visit ien
+8 SET ^TMP("TIUVDT",$JOB,TIUZ(.01,"I"))=1
SET ^TMP("TIUIHSV",$JOB,1)=APCDVSIT
+9 ; set string with clinic, date and service category; used by VA rtns
+10 SET VSTR=+TIUZ(.22,"I")_";"_+TIUZ(.01,"I")_";"_TIUZ(.07,"I")
+11 ; if hosp loc (clinic name) is set, TIUSDC=clinic code^amis stop code
+12 IF +$GET(APCDHL)
IF $PIECE($GET(^SC(+APCDHL,0)),U,3)'="W"
Begin DoDot:1
+13 SET TIUSDC=+$PIECE($GET(^SC(+APCDHL,0)),U,7)_U_$PIECE($GET(^DIC(40.7,+$PIECE($GET(^SC(+APCDHL,0)),U,7),0)),U,2)
End DoDot:1
+14 ;
+15 ; made it this far, set a-okay variables
+16 SET TIUER=0
SET TIUOK=1
+17 QUIT
+18 ;
STUFVST(DFN,VDATE,APCDCLN) ; -- auto-add of visit if not found
+1 QUIT
+2 NEW VSIT,VTYPE,TIUY,DA,DIE,DR,X,Y,DEFAULT,QUES,TIUZ
+3 SET APCDCAT=$$READ^TIUU("S^A:AMBULATORY;I:IN-HOSPITAL;T:TELEPHONE CALL;C:CHART REVIEW","Service Category","A")
SET APCDCAT=$EXTRACT(APCDCAT)
+4 IF APCDCAT=""
SET TIUER=1
QUIT
+5 ; set standard visit variables
DO VISITSET
IF 'APCDLOC
QUIT
+6 WRITE !!?2,"*Visit Date in Header: ",$GET(TIUHDR("TIUVDT")),"* Remember to add time",!
+7 SET APCDDATE=+$$READ^TIUU("D^::ERX","Visit Date & Time")
+8 IF +APCDDATE'>0
SET TIUER=1
QUIT
+9 SET APCDCLN=+$$READ^TIUU("PO^40.7:EMQ","Clinic Code",$GET(APCDCLN))
+10 IF APCDCAT="I"
IF APCDCLN<1
KILL APCDCLN
+11 ;
+12 ; -- create visit
+13 DO ^APCDALV
IF 'APCDVSIT
SET TIUER=1
QUIT
+14 DO MSG^BTIUU("**Visit Created!**",2,1,1)
+15 DO ENP^XBDIQ1(9000010,APCDVSIT,".01;.06:.08;.11;.22","TIUZ(","I")
+16 SET ^TMP("TIUVNI",$JOB,1)=TIUZ(.01,"I")_U_+TIUZ(.22,"I")_U_TIUZ(.07,"I")
+17 SET ^TMP("TIUVN",$JOB,1)=TIUZ(.01)_U_TIUZ(.22)_U_TIUZ(.07)_U_TIUZ(.08)_U_$$PROV(APCDVSIT)_U_$$GET1^DIQ(9999999.06,+TIUZ(.06,"I"),.08)
+18 SET ^TMP("TIUVDT",$JOB,TIUZ(.01,"I"))=1
SET ^TMP("TIUIHSV",$JOB,1)=APCDVSIT
+19 ;
+20 IF +$GET(APCDHL)
IF $PIECE($GET(^SC(+APCDHL,0)),U,3)'="W"
Begin DoDot:1
+21 SET TIUSDC=+$PIECE($GET(^SC(+APCDHL,0)),U,7)_U_$PIECE($GET(^DIC(40.7,+$PIECE($GET(^SC(+APCDHL,0)),U,7),0)),U,2)
End DoDot:1
+22 SET TIUER=0
+23 QUIT
+24 ;
VISITSET ; -- sets visit variables
+1 ; -- pre-answer some questions
+2 ; location
SET APCDLOC=$GET(DUZ(2))
+3 IF 'APCDLOC!'$DATA(^APCDSITE(+APCDLOC))
SET APCDLOC=$ORDER(^APCCCTRL(0))
+4 IF 'APCDLOC
QUIT
+5 ;type of visit
SET APCDTYPE=$$GET1^DIQ(9001001.2,APCDLOC,.11,"I")
+6 ;patient
SET APCDPAT=+DFN
+7 QUIT
+8 ;
+9 ;
INPT(DFN,VDATE) ; -- return 1 if patient was inpatient on this date
+1 NEW LASTA,VISIT,DSCH
+2 ;no admits
SET LASTA=$ORDER(^AUPNVSIT("AAH",DFN,VDATE))
IF LASTA=""
QUIT 0
+3 ;bad xref
SET VISIT=$ORDER(^AUPNVSIT("AAH",DFN,LASTA,0))
IF VISIT=""
QUIT 0
+4 ;still inpt
IF '$DATA(^AUPNVINP("AD",VISIT))
QUIT 1_U_VISIT
+5 SET DSCH=+$GET(^AUPNVINP(+$ORDER(^AUPNVINP("AD",VISIT,0)),0))
+6 ;already dsch
IF DSCH<(9999999.9999999-VDATE)
QUIT 0
+7 QUIT 1_U_VISIT
+8 ;
SETINPT(VISIT) ; -- set ^tmp for hospitalization
+1 NEW TIUZ,REVDT
+2 DO ENP^XBDIQ1(9000010,VISIT,".01;.07;.08","TIUZ(","I")
+3 SET REVDT=9999999.9999999-TIUZ(.01,"I")
+4 SET ^TMP("TIUVNI",$JOB,1)=REVDT_U_+TIUZ(.08,"I")_U_TIUZ(.07,"I")
+5 SET ^TMP("TIUVN",$JOB,1)=TIUZ(.01)_U_TIUZ(.08)_U_TIUZ(.07)
+6 SET ^TMP("TIUVDT",$JOB,REVDT)=1
SET ^TMP("TIUIHSV",$JOB,1)=VISIT
+7 QUIT
+8 ;
PROV(V) ;EP; -- returns primary provider for visit
+1 NEW X,Y
+2 SET X=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",V,X))
IF 'X!($DATA(Y))
QUIT
Begin DoDot:1
+3 IF $PIECE(^AUPNVPRV(X,0),U,4)'="P"
QUIT
+4 SET Y=$$GET1^DIQ($SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:200,1:6),+^AUPNVPRV(X,0),.01)
End DoDot:1
+5 QUIT $EXTRACT($GET(Y),1,15)
+6 ;
GETCLN() ; -- returns clinic code ien for dictator if defined
+1 ;IHS/ITSC/LJF 01/05/2005 PATCH 1001
IF $GET(TIUCLNC)
SET X=$ORDER(^DIC(40.7,"C",TIUCLNC,0))
IF X
QUIT X
+2 NEW X,Y,DIC,USR,CODE,TIUCLNC
+3 ; -- does title have clinic code?
+4 SET Y=$ORDER(^TIU(8925.1,+$GET(TIUTYPE),"HEAD","E","TIUCLNC",0))
+5 IF Y
SET CODE=$GET(^TIU(8925.1,+TIUTYPE,"HEAD",Y,1))
+6 IF $GET(CODE)]""
XECUTE CODE
+7 IF $GET(TIUCLNC)
SET X=$ORDER(^DIC(40.7,"C",TIUCLNC,0))
IF X
QUIT X
+8 ;
+9 ; -- does author have clinic code?
+10 SET X=$$INAME^TIULS(TIUAUTH)
SET DIC=200
SET DIC(0)="M"
DO ^DIC
IF Y<1
QUIT ""
+11 SET USR=0
FOR
SET USR=$ORDER(^USR(8930.3,"B",+Y,USR))
IF 'USR!($GET(CODE))
QUIT
Begin DoDot:1
+12 SET CODE=$$GET1^DIQ(8930.3,USR,9999999.02,"I")
End DoDot:1
+13 QUIT $GET(CODE)
