DGPMGLG4.m

DGPMGLG4 ;ALB/ABR - G&L GENERATION CONT.;  17 MAY 94

 ;;5.3;Registration;**34,1015**;Aug.13, 1993;Build 21

 ;

 ;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

DGPMGLG4  ;ALB/ABR - G&L GENERATION CONT.;  17 MAY 94

 +1       ;;5.3;Registration;**34,1015**;Aug.13, 1993;Build 21

 +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