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

SDVSIT.m

Go to the documentation of this file.
  1. SDVSIT ;MJK/ALB - Visit Tracking Processing ; 12/19/12 10:13am
  1. ;;5.3;Scheduling;**27,44,75,96,132,161,219,630**;Aug 13, 1993;Build 2
  1. ;
  1. AEUPD(SDVIEN,SDATYPE,SDOEP) ; -- update one entry in multiple
  1. ; input: SDVIEN := Visit file pointer
  1. ; SDATYPE := Appointment Type [optional]
  1. ; SDOEP := ien of ^SCE that is the parent encounter [optional]
  1. ;
  1. N SDOE,DA,DR,DE,DQ,DIE,SD0,SDVSIT,SDT,SDLOCK,SDCL0
  1. ;
  1. G AEUPDQ:'$G(^AUPNVSIT(+$G(SDVIEN),0)) S SD0=^(0)
  1. S SDT=+SD0
  1. S SDVSIT("DFN")=$P(SD0,U,5)
  1. I ('SDVSIT("DFN")) G AEUPDQ
  1. ;
  1. ; -- set lock data and lock
  1. S SDLOCK("DFN")=$P(SD0,U,5)
  1. S SDLOCK("EVENT DATE/TIME")=SDT
  1. D LOCK(.SDLOCK)
  1. ;
  1. ; -- quit if encounter does exist for visit
  1. IF $O(^SCE("AVSIT",SDVIEN,0)) G AEUPDQ
  1. ;
  1. S SDVSIT("DIV")=+$P($G(^SC(+$P(SD0,U,22),0)),U,15)
  1. S SDVSIT("DIV")=$$DIV(SDVSIT("DIV"))
  1. I ('SDVSIT("DIV")) G AEUPDQ
  1. ;
  1. S SDVSIT("CLN")=+$P(SD0,U,8)
  1. ; -- this may not be needed any longer but doesn't hurt (mjk)
  1. I $P($G(^DIC(40.7,+$P(SD0,U,8),0)),U,2)=900 S SDVSIT("CLN")=+$P($G(^SC(+$P(SD0,U,22),0)),U,7)
  1. I 'SDVSIT("CLN") G AEUPDQ
  1. ;
  1. S:$P(SD0,U,22) SDVSIT("LOC")=$P(SD0,U,22)
  1. S:$P(SD0,U,21) SDVSIT("ELG")=$P(SD0,U,21)
  1. S SDVSIT("TYP")=$G(SDATYPE)
  1. S SDVSIT("PAR")=$G(SDOEP)
  1. S SDVSIT("ORG")=2
  1. S SDVSIT("REF")=""
  1. S SDOE=$$SDOE(SDT,.SDVSIT,SDVIEN,$G(SDOEP))
  1. S SDCL0=$G(^SC(+SDVSIT("LOC"),0))
  1. D CSTOP(SDOE,SDCL0,.SDVSIT,SDT) ;Process credit stop if applicable
  1. AEUPDQ D UNLOCK(.SDLOCK)
  1. Q
  1. ;
  1. APPT(DFN,SDT,SDCL,SDVIEN) ; -- process appt
  1. ; input DFN = ien of patient file entry
  1. ; SDT = visit date internal format
  1. ; SDCL = ien of hospital location file entry
  1. ; SDVIEN = Visit file pointer [optional]
  1. ;
  1. N SDVSIT,SDOE,DA,DIE,DR,SDPT,SDSC,SDCL0,SDDA,SDLOCK
  1. ;
  1. ; -- set lock data and lock
  1. S SDLOCK("DFN")=DFN
  1. S SDLOCK("EVENT DATE/TIME")=SDT
  1. D LOCK(.SDLOCK)
  1. ;
  1. ; -- set node vars
  1. S SDPT=$G(^DPT(DFN,"S",SDT,0))
  1. S SDCL0=$G(^SC(SDCL,0)),SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
  1. S SDSC=$G(^SC(SDCL,"S",SDT,1,SDDA,0))
  1. S SDVSIT("CLN")=$P(SDCL0,U,7),SDVSIT("DIV")=$$DIV($P(SDCL0,U,15))
  1. ;
  1. ; -- do checks
  1. I 'SDPT!('SDSC)!($P(SDCL0,U,3)'="C") G APPTQ
  1. I SDCL,+SDPT'=SDCL G APPTQ
  1. I $P(SDPT,U,20) G APPTQ
  1. I 'SDVSIT("CLN")!('SDVSIT("DIV")) G APPTQ
  1. ;
  1. ; -- set the rest
  1. S SDVSIT("DFN")=DFN,SDVSIT("LOC")=SDCL
  1. S:$P(SDSC,U,10) SDVSIT("ELG")=$P(SDSC,U,10)
  1. S:$P(SDPT,U,16) SDVSIT("TYP")=$P(SDPT,U,16)
  1. ;
  1. ; -- call logic to add opt encounter(s)
  1. S SDVSIT("ORG")=1,SDVSIT("REF")=SDDA,SDOE=$$SDOE(SDT,.SDVSIT,$G(SDVIEN))
  1. I SDOE D
  1. .N DA,DIE,DR
  1. .S DA=SDT,DA(1)=DFN,DR="21////"_SDOE,DIE="^DPT("_DFN_",""S""," D ^DIE
  1. ;
  1. D CSTOP(SDOE,SDCL0,.SDVSIT,SDT) ;Process credit stop if applicable
  1. ;
  1. APPTQ D UNLOCK(.SDLOCK)
  1. Q
  1. ;
  1. CSTOP(SDOE,SDCL0,SDVSIT,SDT) ;Process credit stop
  1. ;Input: SDOE=encounter ien
  1. ;Input: SDCL0=zeroeth node of HOSPITAL LOCATION file record
  1. ;Input: SDVSIT=visit data array (pass by reference)
  1. ;Input: SDT=encounter date/time
  1. ; -- does clinic have a credit stop code?
  1. ; -- process only if non non-count and not equal to credit
  1. ;
  1. I SDOE,$P(SDCL0,U,18),($P(SDCL0,U,18)'=SDVSIT("CLN")),($P(SDCL0,U,17)'="Y") D
  1. . N X,SDVIENSV,SDVIENOR
  1. . S X=$G(^DIC(40.7,$P(SDCL0,U,18),0))
  1. .; -- is stop code active?
  1. . I $S('$P(X,U,3):1,1:SDT<$P(X,U,3)) D
  1. . . S SDVSIT("CLN")=$P(SDCL0,U,18)
  1. . . S SDVIENOR=$G(SDVSIT("ORG"))
  1. . . S SDVSIT("ORG")=4
  1. . . S SDVSIT("PAR")=SDOE
  1. . . S SDVIENSV=$G(SDVSIT("VST"))
  1. . . K SDVSIT("VST")
  1. . . S X=$$SDOE(SDT,.SDVSIT)
  1. . . IF X D LOGDATA^SDAPIAP(X)
  1. . .;
  1. . .; -- restore SDVSIT
  1. . . S SDVSIT("CLN")=$P(SDCL0,U,7)
  1. . . S SDVSIT("ORG")=SDVIENOR
  1. . . S SDVSIT("VST")=SDVIENSV
  1. . . K SDVSIT("PAR")
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. DISP(DFN,SDT,SDVIEN) ; -- process disposition
  1. ; input DFN = ien of patient file entry
  1. ; SDT = visit date internal format
  1. ; SDIV = ien of med ctr file entry
  1. ; SDVIEN = Visit file pointer [optional]
  1. ;
  1. N SDVSIT,SDOE,DA,DIE,DR,SDIS,SDDA,SDLOCK
  1. ;
  1. ; -- set lock data and lock
  1. S SDLOCK("DFN")=DFN
  1. S SDLOCK("EVENT DATE/TIME")=SDT
  1. D LOCK(.SDLOCK)
  1. ;
  1. ; -- set up array and other vars
  1. D ARRAY(.DFN,.SDT,.SDDA,.SDIS,.SDVSIT)
  1. ;
  1. ; -- do checks
  1. I $P(SDIS,U,2)=2!($P(SDIS,U,2)="")!($P(SDIS,U,18)) G DISPQ
  1. I 'SDVSIT("CLN")!('SDVSIT("DIV")) G DISPQ
  1. ;
  1. ; -- call logic to add opt encounter/visit
  1. S SDOE=$$SDOE(SDT,.SDVSIT,$G(SDVIEN))
  1. I SDOE S DA=SDDA,DA(1)=DFN,DR="18////"_SDOE,DIE="^DPT("_DFN_",""DIS""," D ^DIE
  1. DISPQ D UNLOCK(.SDLOCK)
  1. Q
  1. ;
  1. ARRAY(DFN,SDT,SDDA,SDIS,SDVSIT) ; -- setup sdvsit for disposition
  1. S SDDA=9999999-SDT
  1. S SDIS=$G(^DPT(DFN,"DIS",SDDA,0))
  1. S SDVSIT("CLN")=$O(^DIC(40.7,"C",102,0))
  1. S SDVSIT("DIV")=$$DIV(+$P(SDIS,U,4))
  1. S:$P(SDIS,U,13) SDVSIT("ELG")=$P(SDIS,U,13)
  1. S SDVSIT("DFN")=DFN
  1. S SDVSIT("ORG")=3
  1. S SDVSIT("REF")=SDDA
  1. S SDVSIT("VST")=""
  1. S SDVSIT("TYP")=9
  1. Q
  1. ;
  1. LOCK(SDLOCK) ; -- lock "ADFN" node
  1. F L +^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME"))):$G(DILOCKTM,3) Q:$T ;LLS - 05-JAN-15 - SD*5.3*630 added timeout on lock
  1. Q
  1. ;
  1. UNLOCK(SDLOCK) ; -- unlock "ADFN" node
  1. L -^SCE("ADFN",+$G(SDLOCK("DFN")),+$G(SDLOCK("EVENT DATE/TIME")))
  1. Q
  1. ;
  1. DIV(DIV) ; -- determine med div
  1. I $P($G(^DG(43,1,"GL")),U,2),$D(^DG(40.8,+DIV,0)) G DIVQ ; multi-div?
  1. S DIV=+$O(^DG(40.8,0))
  1. DIVQ Q DIV
  1. ;
  1. ; -- see bottom of SDVSIT0 for additional doc
  1. ;
  1. SDOE(SDT,SDVSIT,SDVIEN,SDOEP) ; -- get visit & encounter
  1. N SDTR,SDI ;LLS 22-DEC-2014 - SD*5.3*630 - added
  1. S SDTR=9999999-$P(SDT,".") ;LLS 22-DEC-2014 - SD*5.3*630 - added
  1. I SDT["." S SDTR=SDTR_"."_$P(SDT,".",2) ;LLS 22-DEC-2014 - SD*5.3*630 - added
  1. I '$D(SDVSIT("PAR")),$G(SDVIEN)="" D ;LLS 22-DEC-2014 - SD*5.3*630 - added the following section
  1. . N SDVISARR,SDVIEN1
  1. . S SDVIEN1="" F S SDVIEN1=$O(^AUPNVSIT("AA",DFN,SDTR,SDVIEN1)) Q:SDVIEN1="" D Q:$G(SDVIEN)]""
  1. . . ; COMPARE VISIT: SERVICE CATEGORY, POINTER TO CLINIC STOP FILE, POINTER TO HOSPITAL LOCATION
  1. . . ; FILE, & ENCOUNTER TYPE BEFORE SELECTING EXISTING VISIT INSTEAD OF CREATING A NEW ONE
  1. . . D GETS^DIQ(9000010,SDVIEN1_",",".07;.08;.22;15003","I","SDVISARR")
  1. . . Q:SDVISARR(9000010,SDVIEN1_",",.07,"I")'=$S($G(SDVSIT("SVC"))]"":SDVSIT("SVC"),$$INP^SDAM2(DFN,SDTR)="I":"I",1:"A")
  1. . . Q:SDVISARR(9000010,SDVIEN1_",",.08,"I")'=$G(SDVSIT("CLN"))
  1. . . Q:SDVISARR(9000010,SDVIEN1_",",.22,"I")'=$G(SDVSIT("LOC"))
  1. . . Q:SDVISARR(9000010,SDVIEN1_",",15003,"I")'="P"
  1. . . S SDVIEN=SDVIEN1
  1. S SDVSIT("VST")=$G(SDVIEN)
  1. IF 'SDVSIT("VST") D VISIT^SDVSIT0(SDT,.SDVSIT)
  1. Q $$NEW^SDVSIT0(SDT,.SDVSIT)
  1. ;
  1. ;
  1. DATECHCK(DATETIME) ;Validate FileMan date/time
  1. ;Input : DATETIME - Date and optional time in FileMan format
  1. ;Output : DATETIME - Valid date/time in FileMan format
  1. ;Notes : If time was not included on input, time will not be included
  1. ; on output
  1. ; : If time rolls past midnight, 235959 (one second before
  1. ; midnight) will be used
  1. ; : Current date/time will be returned on NULL input
  1. ; : Current date will be used if input date is not valid
  1. ;
  1. ;Check input
  1. Q:($G(DATETIME)="") $$NOW^XLFDT()
  1. ;Declare variables
  1. N DATE,TIME,HR,MIN,SEC,X,Y,%DT
  1. ;Break out date & time
  1. S DATE=$P(DATETIME,".",1)
  1. S TIME=$P(DATETIME,".",2)_"000000"
  1. ;Validate date
  1. S X=DATE
  1. S %DT="X"
  1. D ^%DT
  1. ;Date not valid - use current date
  1. S:(Y<0) DATE=$$DT^XLFDT()
  1. ;No time - return date
  1. Q:('TIME) DATE
  1. ;Break out hours, minutes, and seconds
  1. S HR=$E(TIME,1,2)
  1. S MIN=$E(TIME,3,4)
  1. S SEC=$E(TIME,5,6)
  1. ;Validate seconds - increment minutes if needed
  1. S:(SEC>59) MIN=MIN+1,SEC=SEC-60
  1. ;Validate minutes - increment hours if needed
  1. S:(MIN>59) HR=HR+1,MIN=MIN-60
  1. ;Validate hours - revert to one second before midnight
  1. S:(HR>23) HR=23,MIN=59,SEC=59
  1. ;Append leading zeros to hours, minutes, and seconds
  1. S HR="00"_HR
  1. S HR=$E(HR,($L(HR)-1),$L(HR))
  1. S MIN="00"_MIN
  1. S MIN=$E(MIN,($L(MIN)-1),$L(MIN))
  1. S SEC="00"_SEC
  1. S SEC=$E(SEC,($L(SEC)-1),$L(SEC))
  1. ;Rebuild time
  1. S TIME=HR_MIN_SEC
  1. ;Done - return date and time (trailing zeros removed)
  1. Q +(DATE_"."_TIME)