124 lines
4.3 KiB
Mathematica
124 lines
4.3 KiB
Mathematica
SCDXUTL ;ALB/JLU;Utility routine for ambcare project;4/26/96
|
|
;;5.3;Scheduling;**44,78,132**;5/1/96
|
|
;
|
|
DATE(DATE) ;this entry point will accept a date and return whether the new or old Scheduling Visits file limitations are to be used.
|
|
;INPUTS - a date in FM format to be compared to the ambcare start
|
|
; date parameter,
|
|
;OUTPUTS - 1 for using the new structure
|
|
; 0 for using the old structure
|
|
;
|
|
N PAR,ANS
|
|
S PAR=$P($G(^SD(404.91,1,"AMB")),U,2) ;get parameter date
|
|
I 'PAR S ANS=0 G QT
|
|
I DATE<PAR S ANS=0 G QT ;if date passed in older than parameter us old
|
|
S ANS=1
|
|
QT Q ANS
|
|
;
|
|
FMDATE() ;this entry point returns the FM date from the parameter of
|
|
;whether to use the new or old structure.
|
|
Q $P($G(^SD(404.91,1,"AMB")),U,2)
|
|
;
|
|
CLOSED(DATE) ;this entry point accepts a date, compares it to the close out
|
|
;date and returns whether the close out period is up.
|
|
;INPUTS - a date in FM format to be compared to the close out date
|
|
; parameter.
|
|
;OUTPUTS - 1 for close out period is over
|
|
; 0 for still being able to close out
|
|
;
|
|
N PAR,ANS
|
|
S PAR=$P($G(^SD(404.91,1,"AMB")),U,3) ;gets close out parameter
|
|
I 'PAR S ANS=0 G CQT
|
|
I DATE<PAR S ANS=0 G CQT ;if date is after close out date parameter 1.
|
|
S ANS=1
|
|
CQT Q ANS
|
|
;
|
|
CLOSEFM() ;this entry point returns the close out date parameter in FM format.
|
|
Q $P($G(^SD(404.91,1,"AMB")),U,3)
|
|
;
|
|
INPATENC(PTR,PTR2) ;ALB/JRP - Determine if an Outpatient Encounter
|
|
; is for an inpatient appointment
|
|
;
|
|
;Input : PTR - Pointer to one of the following files:
|
|
; * TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73)
|
|
; * OUTPATIENT ENCOUNTER file (#409.68)
|
|
; * DELETED OUTPATIENT ENCOUNTER file (#409.74)
|
|
; PTR2 - Denotes which file PTR points to
|
|
; 0 = TRANSMITTED OUTPATIENT ENCOUNTER file (Default)
|
|
; 1 = OUTPATIENT ENCOUNTER file
|
|
; 2 = DELETED OUTPATIENT ENCOUNTER file
|
|
;Output : 0 - Encounter is not an inpatient appointment
|
|
; 1 - Encounter is an inpatient appointment
|
|
;Notes : 0 is returned if a valid pointer is not passed or the
|
|
; entry in the TRANSMITTED OUTPATIENT ENCOUNTER file does
|
|
; not point to a valid entry in the OUTPATIENT ENCOUNTER
|
|
; file or DELETED OUTPATIENT ENCOUNTER file
|
|
;
|
|
;Check input
|
|
S PTR=+$G(PTR)
|
|
Q:('PTR) 0
|
|
S PTR2=+$G(PTR2)
|
|
S:((PTR2<0)!(PTR2>2)) PTR2=0
|
|
I ('PTR) Q:('$D(^SD(409.73,PTR,0))) 0
|
|
I (PTR2=1) Q:('$D(^SCE(PTR,0))) 0
|
|
I (PTR2=2) Q:('$D(^SD(409.74,PTR,0))) 0
|
|
;Declare variables
|
|
N ZERONODE,STATPTR,STATUS
|
|
;Passed pointer to TRANSMITTED OUTPATIENT ENCOUNTER file
|
|
; Convert to pointer to [DELETED] OUTPATIENT ENCOUNTER file
|
|
; Quit if it can't be converted
|
|
I ('PTR2) D Q:('PTR) 0
|
|
.S ZERONODE=$G(^SD(409.73,PTR,0))
|
|
.S PTR=+$P(ZERONODE,"^",2)
|
|
.;Entry is for an outpatient encounter
|
|
.I (PTR) S PTR2=1 Q
|
|
.;Entry is for a deleted outpatient encounter
|
|
.S PTR=+$P(ZERONODE,"^",3)
|
|
.S PTR2=2
|
|
;Get zero node of [deleted] encounter
|
|
S ZERONODE=$G(^SCE(PTR,0))
|
|
S:(PTR2=2) ZERONODE=$G(^SD(409.74,PTR,1))
|
|
;Get pointer to appointment status
|
|
S STATPTR=+$P(ZERONODE,"^",12)
|
|
Q:('STATPTR) 0
|
|
;Get zero node of appointment status
|
|
S ZERONODE=$G(^SD(409.63,STATPTR,0))
|
|
;Get abbreviation for appointment status
|
|
S STATUS=$P(ZERONODE,"^",2)
|
|
;Inpatient appointments have an abbreviation of 'I'
|
|
Q:(STATUS="I") 1
|
|
;Not an inpatient appointment
|
|
Q 0
|
|
;
|
|
DATECHK() ;this function call returns whether to require diag/prov based
|
|
;on the date function call and whether the post init has run.
|
|
;there are no inout variables.
|
|
;
|
|
;a 1 if after 10/1 or the post init has been run to require diag etc.
|
|
;a 0 if not to require yet
|
|
;
|
|
N DATE,ANS
|
|
S ANS=$$DATE(DT) I ANS G DATECHKQ
|
|
I $P(^SD(404.91,1,"AMB"),U,7) S ANS=1 G DATECHKQ
|
|
S ANS=0
|
|
DATECHKQ Q ANS
|
|
;
|
|
OCCA(CLN) ;This function call returns whether or not the clinic is
|
|
;considered an occasion of service, based upon file 409.45.
|
|
;
|
|
;CLN is the clinic in question
|
|
;
|
|
;a 1 if this clinic is an occasion of service clinic
|
|
;a 0 if not
|
|
;
|
|
N SCP,SC,ANS
|
|
I '$D(^SC(CLN,0)) S ANS=0 G OCCAQ
|
|
S SCP=$P(^SC(CLN,0),U,7)
|
|
I 'SCP S ANS=0 G OCCAQ
|
|
I '$D(^DIC(40.7,SCP,0)) S ANS=0 G OCCAQ
|
|
S SC=$P(^DIC(40.7,SCP,0),U,2)
|
|
I 'SC S ANS=0 G OCCAQ
|
|
I '$O(^SD(409.45,"B",SC,"")) S ANS=0 G OCCAQ
|
|
I "117^118^119^120^121^123^124^125^126^128^152^165^170^999"[SC S ANS=0 G OCCAQ
|
|
S ANS=1
|
|
OCCAQ Q ANS
|