| 1 | SCDXUTL ;ALB/JLU;Utility routine for ambcare project;4/26/96
|
|---|
| 2 | ;;5.3;Scheduling;**44,78,132**;5/1/96
|
|---|
| 3 | ;
|
|---|
| 4 | DATE(DATE) ;this entry point will accept a date and return whether the new or old Scheduling Visits file limitations are to be used.
|
|---|
| 5 | ;INPUTS - a date in FM format to be compared to the ambcare start
|
|---|
| 6 | ; date parameter,
|
|---|
| 7 | ;OUTPUTS - 1 for using the new structure
|
|---|
| 8 | ; 0 for using the old structure
|
|---|
| 9 | ;
|
|---|
| 10 | N PAR,ANS
|
|---|
| 11 | S PAR=$P($G(^SD(404.91,1,"AMB")),U,2) ;get parameter date
|
|---|
| 12 | I 'PAR S ANS=0 G QT
|
|---|
| 13 | I DATE<PAR S ANS=0 G QT ;if date passed in older than parameter us old
|
|---|
| 14 | S ANS=1
|
|---|
| 15 | QT Q ANS
|
|---|
| 16 | ;
|
|---|
| 17 | FMDATE() ;this entry point returns the FM date from the parameter of
|
|---|
| 18 | ;whether to use the new or old structure.
|
|---|
| 19 | Q $P($G(^SD(404.91,1,"AMB")),U,2)
|
|---|
| 20 | ;
|
|---|
| 21 | CLOSED(DATE) ;this entry point accepts a date, compares it to the close out
|
|---|
| 22 | ;date and returns whether the close out period is up.
|
|---|
| 23 | ;INPUTS - a date in FM format to be compared to the close out date
|
|---|
| 24 | ; parameter.
|
|---|
| 25 | ;OUTPUTS - 1 for close out period is over
|
|---|
| 26 | ; 0 for still being able to close out
|
|---|
| 27 | ;
|
|---|
| 28 | N PAR,ANS
|
|---|
| 29 | S PAR=$P($G(^SD(404.91,1,"AMB")),U,3) ;gets close out parameter
|
|---|
| 30 | I 'PAR S ANS=0 G CQT
|
|---|
| 31 | I DATE<PAR S ANS=0 G CQT ;if date is after close out date parameter 1.
|
|---|
| 32 | S ANS=1
|
|---|
| 33 | CQT Q ANS
|
|---|
| 34 | ;
|
|---|
| 35 | CLOSEFM() ;this entry point returns the close out date parameter in FM format.
|
|---|
| 36 | Q $P($G(^SD(404.91,1,"AMB")),U,3)
|
|---|
| 37 | ;
|
|---|
| 38 | INPATENC(PTR,PTR2) ;ALB/JRP - Determine if an Outpatient Encounter
|
|---|
| 39 | ; is for an inpatient appointment
|
|---|
| 40 | ;
|
|---|
| 41 | ;Input : PTR - Pointer to one of the following files:
|
|---|
| 42 | ; * TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73)
|
|---|
| 43 | ; * OUTPATIENT ENCOUNTER file (#409.68)
|
|---|
| 44 | ; * DELETED OUTPATIENT ENCOUNTER file (#409.74)
|
|---|
| 45 | ; PTR2 - Denotes which file PTR points to
|
|---|
| 46 | ; 0 = TRANSMITTED OUTPATIENT ENCOUNTER file (Default)
|
|---|
| 47 | ; 1 = OUTPATIENT ENCOUNTER file
|
|---|
| 48 | ; 2 = DELETED OUTPATIENT ENCOUNTER file
|
|---|
| 49 | ;Output : 0 - Encounter is not an inpatient appointment
|
|---|
| 50 | ; 1 - Encounter is an inpatient appointment
|
|---|
| 51 | ;Notes : 0 is returned if a valid pointer is not passed or the
|
|---|
| 52 | ; entry in the TRANSMITTED OUTPATIENT ENCOUNTER file does
|
|---|
| 53 | ; not point to a valid entry in the OUTPATIENT ENCOUNTER
|
|---|
| 54 | ; file or DELETED OUTPATIENT ENCOUNTER file
|
|---|
| 55 | ;
|
|---|
| 56 | ;Check input
|
|---|
| 57 | S PTR=+$G(PTR)
|
|---|
| 58 | Q:('PTR) 0
|
|---|
| 59 | S PTR2=+$G(PTR2)
|
|---|
| 60 | S:((PTR2<0)!(PTR2>2)) PTR2=0
|
|---|
| 61 | I ('PTR) Q:('$D(^SD(409.73,PTR,0))) 0
|
|---|
| 62 | I (PTR2=1) Q:('$D(^SCE(PTR,0))) 0
|
|---|
| 63 | I (PTR2=2) Q:('$D(^SD(409.74,PTR,0))) 0
|
|---|
| 64 | ;Declare variables
|
|---|
| 65 | N ZERONODE,STATPTR,STATUS
|
|---|
| 66 | ;Passed pointer to TRANSMITTED OUTPATIENT ENCOUNTER file
|
|---|
| 67 | ; Convert to pointer to [DELETED] OUTPATIENT ENCOUNTER file
|
|---|
| 68 | ; Quit if it can't be converted
|
|---|
| 69 | I ('PTR2) D Q:('PTR) 0
|
|---|
| 70 | .S ZERONODE=$G(^SD(409.73,PTR,0))
|
|---|
| 71 | .S PTR=+$P(ZERONODE,"^",2)
|
|---|
| 72 | .;Entry is for an outpatient encounter
|
|---|
| 73 | .I (PTR) S PTR2=1 Q
|
|---|
| 74 | .;Entry is for a deleted outpatient encounter
|
|---|
| 75 | .S PTR=+$P(ZERONODE,"^",3)
|
|---|
| 76 | .S PTR2=2
|
|---|
| 77 | ;Get zero node of [deleted] encounter
|
|---|
| 78 | S ZERONODE=$G(^SCE(PTR,0))
|
|---|
| 79 | S:(PTR2=2) ZERONODE=$G(^SD(409.74,PTR,1))
|
|---|
| 80 | ;Get pointer to appointment status
|
|---|
| 81 | S STATPTR=+$P(ZERONODE,"^",12)
|
|---|
| 82 | Q:('STATPTR) 0
|
|---|
| 83 | ;Get zero node of appointment status
|
|---|
| 84 | S ZERONODE=$G(^SD(409.63,STATPTR,0))
|
|---|
| 85 | ;Get abbreviation for appointment status
|
|---|
| 86 | S STATUS=$P(ZERONODE,"^",2)
|
|---|
| 87 | ;Inpatient appointments have an abbreviation of 'I'
|
|---|
| 88 | Q:(STATUS="I") 1
|
|---|
| 89 | ;Not an inpatient appointment
|
|---|
| 90 | Q 0
|
|---|
| 91 | ;
|
|---|
| 92 | DATECHK() ;this function call returns whether to require diag/prov based
|
|---|
| 93 | ;on the date function call and whether the post init has run.
|
|---|
| 94 | ;there are no inout variables.
|
|---|
| 95 | ;
|
|---|
| 96 | ;a 1 if after 10/1 or the post init has been run to require diag etc.
|
|---|
| 97 | ;a 0 if not to require yet
|
|---|
| 98 | ;
|
|---|
| 99 | N DATE,ANS
|
|---|
| 100 | S ANS=$$DATE(DT) I ANS G DATECHKQ
|
|---|
| 101 | I $P(^SD(404.91,1,"AMB"),U,7) S ANS=1 G DATECHKQ
|
|---|
| 102 | S ANS=0
|
|---|
| 103 | DATECHKQ Q ANS
|
|---|
| 104 | ;
|
|---|
| 105 | OCCA(CLN) ;This function call returns whether or not the clinic is
|
|---|
| 106 | ;considered an occasion of service, based upon file 409.45.
|
|---|
| 107 | ;
|
|---|
| 108 | ;CLN is the clinic in question
|
|---|
| 109 | ;
|
|---|
| 110 | ;a 1 if this clinic is an occasion of service clinic
|
|---|
| 111 | ;a 0 if not
|
|---|
| 112 | ;
|
|---|
| 113 | N SCP,SC,ANS
|
|---|
| 114 | I '$D(^SC(CLN,0)) S ANS=0 G OCCAQ
|
|---|
| 115 | S SCP=$P(^SC(CLN,0),U,7)
|
|---|
| 116 | I 'SCP S ANS=0 G OCCAQ
|
|---|
| 117 | I '$D(^DIC(40.7,SCP,0)) S ANS=0 G OCCAQ
|
|---|
| 118 | S SC=$P(^DIC(40.7,SCP,0),U,2)
|
|---|
| 119 | I 'SC S ANS=0 G OCCAQ
|
|---|
| 120 | I '$O(^SD(409.45,"B",SC,"")) S ANS=0 G OCCAQ
|
|---|
| 121 | I "117^118^119^120^121^123^124^125^126^128^152^165^170^999"[SC S ANS=0 G OCCAQ
|
|---|
| 122 | S ANS=1
|
|---|
| 123 | OCCAQ Q ANS
|
|---|
