| 1 | DGPMGLG4 ;ALB/ABR - G&L GENERATION CONT.; 17 MAY 94
|
|---|
| 2 | ;;5.3;Registration;**34**;Aug.13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;This routine finds the division associated with a given
|
|---|
| 5 | ;Treating Specialty transaction.
|
|---|
| 6 | ;
|
|---|
| 7 | ;It finds the division of the ward where the patient is
|
|---|
| 8 | ;located at the time of the TS transaction.
|
|---|
| 9 | ;
|
|---|
| 10 | ;Variables:
|
|---|
| 11 | ; LTSDV - last treating specialty division.
|
|---|
| 12 | ; this is the division for the current treating specialty transaction.
|
|---|
| 13 | ; PTSDV - previous treating specialty division.
|
|---|
| 14 | ;
|
|---|
| 15 | TSDIV ;entry point for division search
|
|---|
| 16 | S LTSDV=$$TSDV(+MV("LWD"))
|
|---|
| 17 | ;
|
|---|
| 18 | TSDIVP ; entry point for Previous TS division only
|
|---|
| 19 | ;
|
|---|
| 20 | ;If transaction is a TS/Provider change, without an associated
|
|---|
| 21 | ;physical movement, then the previous TS division will be the same as
|
|---|
| 22 | ;the current division.
|
|---|
| 23 | I MV("TT")=6,'$P(MD,"^",24) S PTSDV=LTSDV Q
|
|---|
| 24 | S PTSDV=$$TSDV(+MV("PWD"))
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | TSDV(X) ; This function returns the TS division
|
|---|
| 28 | N DV
|
|---|
| 29 | S DV=$P($G(^DIC(42,+X,0)),"^",11)
|
|---|
| 30 | I '$D(^DG(40.8,+DV,0)) S DV=DIV
|
|---|
| 31 | Q +DV
|
|---|
| 32 | Q
|
|---|
| 33 | ASIHR ;to find PTS, PTSDV for returns from ASIH
|
|---|
| 34 | N J1,J2,T,PMT
|
|---|
| 35 | S J1=J
|
|---|
| 36 | F S J1=$O(^DGPM("APMV",DFN,MV("CA"),J1)) Q:'J1 S J2=$O(^(J1,0)) D Q:$D(T)
|
|---|
| 37 | .S PMT=$P(^DGPM(J2,0),"^",18),PMT="^"_PMT_"^"
|
|---|
| 38 | .I '$F("^13^43^44^45^",PMT) S T=1
|
|---|
| 39 | I '$D(T) Q
|
|---|
| 40 | S MV("PWD")=$P($G(^DGPM(J2,0)),"^",6),PTSDV=$$TSDV(MV("PWD")) ; find division for previous TS
|
|---|
| 41 | S J1=$O(^DGPM("ATS",DFN,MV("CA"),9999999.9999999-MD)),J2=$O(^(J1,0)),MV("PTS")=J2 ; find previous TS
|
|---|
| 42 | Q
|
|---|
