DGPMGLG4 ;ALB/ABR - G&L GENERATION CONT.; 17 MAY 94
;;5.3;Registration;**34**;Aug.13, 1993
;
;This routine finds the division associated with a given
;Treating Specialty transaction.
;
;It finds the division of the ward where the patient is
;located at the time of the TS transaction.
;
;Variables:
; LTSDV - last treating specialty division.
; this is the division for the current treating specialty transaction.
; PTSDV - previous treating specialty division.
;
TSDIV ;entry point for division search
S LTSDV=$$TSDV(+MV("LWD"))
;
TSDIVP ; entry point for Previous TS division only
;
;If transaction is a TS/Provider change, without an associated
;physical movement, then the previous TS division will be the same as
;the current division.
I MV("TT")=6,'$P(MD,"^",24) S PTSDV=LTSDV Q
S PTSDV=$$TSDV(+MV("PWD"))
Q
;
TSDV(X) ; This function returns the TS division
N DV
S DV=$P($G(^DIC(42,+X,0)),"^",11)
I '$D(^DG(40.8,+DV,0)) S DV=DIV
Q +DV
Q
ASIHR ;to find PTS, PTSDV for returns from ASIH
N J1,J2,T,PMT
S J1=J
F S J1=$O(^DGPM("APMV",DFN,MV("CA"),J1)) Q:'J1 S J2=$O(^(J1,0)) D Q:$D(T)
.S PMT=$P(^DGPM(J2,0),"^",18),PMT="^"_PMT_"^"
.I '$F("^13^43^44^45^",PMT) S T=1
I '$D(T) Q
S MV("PWD")=$P($G(^DGPM(J2,0)),"^",6),PTSDV=$$TSDV(MV("PWD")) ; find division for previous TS
S J1=$O(^DGPM("ATS",DFN,MV("CA"),9999999.9999999-MD)),J2=$O(^(J1,0)),MV("PTS")=J2 ; find previous TS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMGLG4 1485 printed Oct 16, 2024@18:50:18 Page 2
DGPMGLG4 ;ALB/ABR - G&L GENERATION CONT.; 17 MAY 94
+1 ;;5.3;Registration;**34**;Aug.13, 1993
+2 ;
+3 ;This routine finds the division associated with a given
+4 ;Treating Specialty transaction.
+5 ;
+6 ;It finds the division of the ward where the patient is
+7 ;located at the time of the TS transaction.
+8 ;
+9 ;Variables:
+10 ; LTSDV - last treating specialty division.
+11 ; this is the division for the current treating specialty transaction.
+12 ; PTSDV - previous treating specialty division.
+13 ;
TSDIV ;entry point for division search
+1 SET LTSDV=$$TSDV(+MV("LWD"))
+2 ;
TSDIVP ; entry point for Previous TS division only
+1 ;
+2 ;If transaction is a TS/Provider change, without an associated
+3 ;physical movement, then the previous TS division will be the same as
+4 ;the current division.
+5 IF MV("TT")=6
IF '$PIECE(MD,"^",24)
SET PTSDV=LTSDV
QUIT
+6 SET PTSDV=$$TSDV(+MV("PWD"))
+7 QUIT
+8 ;
TSDV(X) ; This function returns the TS division
+1 NEW DV
+2 SET DV=$PIECE($GET(^DIC(42,+X,0)),"^",11)
+3 IF '$DATA(^DG(40.8,+DV,0))
SET DV=DIV
+4 QUIT +DV
+5 QUIT
ASIHR ;to find PTS, PTSDV for returns from ASIH
+1 NEW J1,J2,T,PMT
+2 SET J1=J
+3 FOR
SET J1=$ORDER(^DGPM("APMV",DFN,MV("CA"),J1))
if 'J1
QUIT
SET J2=$ORDER(^(J1,0))
Begin DoDot:1
+4 SET PMT=$PIECE(^DGPM(J2,0),"^",18)
SET PMT="^"_PMT_"^"
+5 IF '$FIND("^13^43^44^45^",PMT)
SET T=1
End DoDot:1
if $DATA(T)
QUIT
+6 IF '$DATA(T)
QUIT
+7 ; find division for previous TS
SET MV("PWD")=$PIECE($GET(^DGPM(J2,0)),"^",6)
SET PTSDV=$$TSDV(MV("PWD"))
+8 ; find previous TS
SET J1=$ORDER(^DGPM("ATS",DFN,MV("CA"),9999999.9999999-MD))
SET J2=$ORDER(^(J1,0))
SET MV("PTS")=J2
+9 QUIT
