- 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 Apr 23, 2025@18:54:07 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
