- 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 Feb 19, 2025@00:15:43 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
