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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXUTL 4509 printed Dec 13, 2024@02:39:37 Page 2
SCDXUTL ;ALB/JLU;Utility routine for ambcare project;4/26/96
+1 ;;5.3;Scheduling;**44,78,132**;5/1/96
+2 ;
DATE(DATE) ;this entry point will accept a date and return whether the new or old Scheduling Visits file limitations are to be used.
+1 ;INPUTS - a date in FM format to be compared to the ambcare start
+2 ; date parameter,
+3 ;OUTPUTS - 1 for using the new structure
+4 ; 0 for using the old structure
+5 ;
+6 NEW PAR,ANS
+7 ;get parameter date
SET PAR=$PIECE($GET(^SD(404.91,1,"AMB")),U,2)
+8 IF 'PAR
SET ANS=0
GOTO QT
+9 ;if date passed in older than parameter us old
IF DATE<PAR
SET ANS=0
GOTO QT
+10 SET ANS=1
QT QUIT ANS
+1 ;
FMDATE() ;this entry point returns the FM date from the parameter of
+1 ;whether to use the new or old structure.
+2 QUIT $PIECE($GET(^SD(404.91,1,"AMB")),U,2)
+3 ;
CLOSED(DATE) ;this entry point accepts a date, compares it to the close out
+1 ;date and returns whether the close out period is up.
+2 ;INPUTS - a date in FM format to be compared to the close out date
+3 ; parameter.
+4 ;OUTPUTS - 1 for close out period is over
+5 ; 0 for still being able to close out
+6 ;
+7 NEW PAR,ANS
+8 ;gets close out parameter
SET PAR=$PIECE($GET(^SD(404.91,1,"AMB")),U,3)
+9 IF 'PAR
SET ANS=0
GOTO CQT
+10 ;if date is after close out date parameter 1.
IF DATE<PAR
SET ANS=0
GOTO CQT
+11 SET ANS=1
CQT QUIT ANS
+1 ;
CLOSEFM() ;this entry point returns the close out date parameter in FM format.
+1 QUIT $PIECE($GET(^SD(404.91,1,"AMB")),U,3)
+2 ;
INPATENC(PTR,PTR2) ;ALB/JRP - Determine if an Outpatient Encounter
+1 ; is for an inpatient appointment
+2 ;
+3 ;Input : PTR - Pointer to one of the following files:
+4 ; * TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73)
+5 ; * OUTPATIENT ENCOUNTER file (#409.68)
+6 ; * DELETED OUTPATIENT ENCOUNTER file (#409.74)
+7 ; PTR2 - Denotes which file PTR points to
+8 ; 0 = TRANSMITTED OUTPATIENT ENCOUNTER file (Default)
+9 ; 1 = OUTPATIENT ENCOUNTER file
+10 ; 2 = DELETED OUTPATIENT ENCOUNTER file
+11 ;Output : 0 - Encounter is not an inpatient appointment
+12 ; 1 - Encounter is an inpatient appointment
+13 ;Notes : 0 is returned if a valid pointer is not passed or the
+14 ; entry in the TRANSMITTED OUTPATIENT ENCOUNTER file does
+15 ; not point to a valid entry in the OUTPATIENT ENCOUNTER
+16 ; file or DELETED OUTPATIENT ENCOUNTER file
+17 ;
+18 ;Check input
+19 SET PTR=+$GET(PTR)
+20 if ('PTR)
QUIT 0
+21 SET PTR2=+$GET(PTR2)
+22 if ((PTR2<0)!(PTR2>2))
SET PTR2=0
+23 IF ('PTR)
if ('$DATA(^SD(409.73,PTR,0)))
QUIT 0
+24 IF (PTR2=1)
if ('$DATA(^SCE(PTR,0)))
QUIT 0
+25 IF (PTR2=2)
if ('$DATA(^SD(409.74,PTR,0)))
QUIT 0
+26 ;Declare variables
+27 NEW ZERONODE,STATPTR,STATUS
+28 ;Passed pointer to TRANSMITTED OUTPATIENT ENCOUNTER file
+29 ; Convert to pointer to [DELETED] OUTPATIENT ENCOUNTER file
+30 ; Quit if it can't be converted
+31 IF ('PTR2)
Begin DoDot:1
+32 SET ZERONODE=$GET(^SD(409.73,PTR,0))
+33 SET PTR=+$PIECE(ZERONODE,"^",2)
+34 ;Entry is for an outpatient encounter
+35 IF (PTR)
SET PTR2=1
QUIT
+36 ;Entry is for a deleted outpatient encounter
+37 SET PTR=+$PIECE(ZERONODE,"^",3)
+38 SET PTR2=2
End DoDot:1
if ('PTR)
QUIT 0
+39 ;Get zero node of [deleted] encounter
+40 SET ZERONODE=$GET(^SCE(PTR,0))
+41 if (PTR2=2)
SET ZERONODE=$GET(^SD(409.74,PTR,1))
+42 ;Get pointer to appointment status
+43 SET STATPTR=+$PIECE(ZERONODE,"^",12)
+44 if ('STATPTR)
QUIT 0
+45 ;Get zero node of appointment status
+46 SET ZERONODE=$GET(^SD(409.63,STATPTR,0))
+47 ;Get abbreviation for appointment status
+48 SET STATUS=$PIECE(ZERONODE,"^",2)
+49 ;Inpatient appointments have an abbreviation of 'I'
+50 if (STATUS="I")
QUIT 1
+51 ;Not an inpatient appointment
+52 QUIT 0
+53 ;
DATECHK() ;this function call returns whether to require diag/prov based
+1 ;on the date function call and whether the post init has run.
+2 ;there are no inout variables.
+3 ;
+4 ;a 1 if after 10/1 or the post init has been run to require diag etc.
+5 ;a 0 if not to require yet
+6 ;
+7 NEW DATE,ANS
+8 SET ANS=$$DATE(DT)
IF ANS
GOTO DATECHKQ
+9 IF $PIECE(^SD(404.91,1,"AMB"),U,7)
SET ANS=1
GOTO DATECHKQ
+10 SET ANS=0
DATECHKQ QUIT ANS
+1 ;
OCCA(CLN) ;This function call returns whether or not the clinic is
+1 ;considered an occasion of service, based upon file 409.45.
+2 ;
+3 ;CLN is the clinic in question
+4 ;
+5 ;a 1 if this clinic is an occasion of service clinic
+6 ;a 0 if not
+7 ;
+8 NEW SCP,SC,ANS
+9 IF '$DATA(^SC(CLN,0))
SET ANS=0
GOTO OCCAQ
+10 SET SCP=$PIECE(^SC(CLN,0),U,7)
+11 IF 'SCP
SET ANS=0
GOTO OCCAQ
+12 IF '$DATA(^DIC(40.7,SCP,0))
SET ANS=0
GOTO OCCAQ
+13 SET SC=$PIECE(^DIC(40.7,SCP,0),U,2)
+14 IF 'SC
SET ANS=0
GOTO OCCAQ
+15 IF '$ORDER(^SD(409.45,"B",SC,""))
SET ANS=0
GOTO OCCAQ
+16 IF "117^118^119^120^121^123^124^125^126^128^152^165^170^999"[SC
SET ANS=0
GOTO OCCAQ
+17 SET ANS=1
OCCAQ QUIT ANS
