source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCDXUTL.m@ 861

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