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

BTIUVSIT.m

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