DGPMGLG1.m

DGPMGLG1 ;ALB/LM - G&L GENERATION, CONT.; 23 MAY 90

 ;;5.3;Registration;;Aug 13, 1993

 ;

A S DFN=+$P(MD,"^",3),ID="",DPT=$S($D(^DPT(DFN,0)):^(0),1:"")

 D GL,BS,ONEDAY,ASIH

Q K X,X1,X2,J,L

 Q

 ;

GL Q:'GL

 S MV("SS")=$S($P(DPT,"^",9)]"":$E($P(DPT,"^",9),+SS,10),1:"NO SS") ;  SS=SSN format short/long

 I $P(DPT,"^",1)']"" S MV("NM")="UNKNOWN,#"_DFN Q

 S MV("NM")=$E($P(DPT,"^",1),1,18),X=$P(MV("NM"),",",1),X1=$P(MV("NM"),",",2),X2=$E(X1)

 F J=2:1:$L(X1) S L=$E(X1,J) X "S A=$A(L) I A>64,A<91,$E(X1,J-1)?1A S L=$C(A+32)" S X2=X2_L

 S MV("NM")=X_","_X2 ;  first name to lower case format

 Q

 ;

BS S MV("FM")=+$P(MD,"^",4) ;  facility movement

 S MV("CA")=+$P(MD,"^",14) ;  corresponding admission

 S MV("MT")=+$P(MD,"^",18) ;  movement type

 S MV("TT")=+$P(MD,"^",2) ;  transaction type

 S AD=$S($D(^DGPM(+MV("CA"),0)):^(0),1:"") ;  admission movement node

 S MDP="",X=$O(^DGPM("APMV",DFN,MV("CA"),9999999.9999999-(MD+($P(MD,"^",22)/10000000))))

 S MIFN=$O(^DGPM("APMV",DFN,MV("CA"),+X,0)) ;  MIFN=Movement IFN

 I MIFN,$D(^DGPM(+MIFN,0)) S MDP=^(0) ;  movement data previous

 Q

 ;

ONEDAY S MV("OD")=0 I MV("TT")=3,$P(+AD,".")=$P(+MD,".") S MV("OD")=1 ;  date compare adm vs. movement

 Q

 ;

ASIH S MV("AS")=0

 Q:MV("MT")'=42  ;  42=while ASIH

 S MV("AS")=1,X=$O(^DGPM("APID",DFN,9999999.9999999-(MD+($P(MD,"^",22)/10000000))))

 S X=$O(^DGPM("APID",DFN,+X,0))

 S:X X=$S($D(^DGPM(+X,0)):^(0),1:"")

 Q:'X

 Q:$P($P(X,"^"),".")'=$P($P(MD,"^"),".")

 Q:$P(X,"^",2)'=3  ;  3=discharge

 S MV("AS")=$P(X,"^",18)

 Q

 ;

VAR ;  MV("SS")=SS Number

 ;  MV("NM")=Name format

 ;  MV("FM")=Facility Movement

 ;  MV("CA")=Corresponding Admission

 ;  MV("MT")=Movement Type

 ;  MV("TT")=Transaction Type

 ;  AD=Admission Movement Node

 ;  MV("OD")=One Day

 ;  MDP=Movement Data Previous

 ;  MIFN=Movement IFN

 ;  MV("AS")=while ASIH

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPMGLG1   1860     printed  Feb 19, 2025@00:15:41                                                                                                                                                                                                    Page 2

DGPMGLG1  ;ALB/LM - G&L GENERATION, CONT.; 23 MAY 90

 +1       ;;5.3;Registration;;Aug 13, 1993

 +2       ;

A          SET DFN=+$PIECE(MD,"^",3)

           SET ID=""

           SET DPT=$SELECT($DATA(^DPT(DFN,0)):^(0),1:"")

 +1        DO GL

           DO BS

           DO ONEDAY

           DO ASIH

Q          KILL X,X1,X2,J,L

 +1        QUIT 

 +2       ;

GL         if 'GL

               QUIT 

 +1       ;  SS=SSN format short/long

           SET MV("SS")=$SELECT($PIECE(DPT,"^",9)]"":$EXTRACT($PIECE(DPT,"^",9),+SS,10),1:"NO SS")

 +2        IF $PIECE(DPT,"^",1)']""

               SET MV("NM")="UNKNOWN,#"_DFN

               QUIT 

 +3        SET MV("NM")=$EXTRACT($PIECE(DPT,"^",1),1,18)

           SET X=$PIECE(MV("NM"),",",1)

           SET X1=$PIECE(MV("NM"),",",2)

           SET X2=$EXTRACT(X1)

 +4        FOR J=2:1:$LENGTH(X1)

               SET L=$EXTRACT(X1,J)

               XECUTE "S A=$A(L) I A>64,A<91,$E(X1,J-1)?1A S L=$C(A+32)"

               SET X2=X2_L

 +5       ;  first name to lower case format

           SET MV("NM")=X_","_X2

 +6        QUIT 

 +7       ;

BS        ;  facility movement

           SET MV("FM")=+$PIECE(MD,"^",4)

 +1       ;  corresponding admission

           SET MV("CA")=+$PIECE(MD,"^",14)

 +2       ;  movement type

           SET MV("MT")=+$PIECE(MD,"^",18)

 +3       ;  transaction type

           SET MV("TT")=+$PIECE(MD,"^",2)

 +4       ;  admission movement node

           SET AD=$SELECT($DATA(^DGPM(+MV("CA"),0)):^(0),1:"")

 +5        SET MDP=""

           SET X=$ORDER(^DGPM("APMV",DFN,MV("CA"),9999999.9999999-(MD+($PIECE(MD,"^",22)/10000000))))

 +6       ;  MIFN=Movement IFN

           SET MIFN=$ORDER(^DGPM("APMV",DFN,MV("CA"),+X,0))

 +7       ;  movement data previous

           IF MIFN

               IF $DATA(^DGPM(+MIFN,0))

                   SET MDP=^(0)

 +8        QUIT 

 +9       ;

ONEDAY    ;  date compare adm vs. movement

           SET MV("OD")=0

           IF MV("TT")=3

               IF $PIECE(+AD,".")=$PIECE(+MD,".")

                   SET MV("OD")=1

 +1        QUIT 

 +2       ;

ASIH       SET MV("AS")=0

 +1       ;  42=while ASIH

           if MV("MT")'=42

               QUIT 

 +2        SET MV("AS")=1

           SET X=$ORDER(^DGPM("APID",DFN,9999999.9999999-(MD+($PIECE(MD,"^",22)/10000000))))

 +3        SET X=$ORDER(^DGPM("APID",DFN,+X,0))

 +4        if X

               SET X=$SELECT($DATA(^DGPM(+X,0)):^(0),1:"")

 +5        if 'X

               QUIT 

 +6        if $PIECE($PIECE(X,"^"),".")'=$PIECE($PIECE(MD,"^"),".")

               QUIT 

 +7       ;  3=discharge

           if $PIECE(X,"^",2)'=3

               QUIT 

 +8        SET MV("AS")=$PIECE(X,"^",18)

 +9        QUIT 

 +10      ;

VAR       ;  MV("SS")=SS Number

 +1       ;  MV("NM")=Name format

 +2       ;  MV("FM")=Facility Movement

 +3       ;  MV("CA")=Corresponding Admission

 +4       ;  MV("MT")=Movement Type

 +5       ;  MV("TT")=Transaction Type

 +6       ;  AD=Admission Movement Node

 +7       ;  MV("OD")=One Day

 +8       ;  MDP=Movement Data Previous

 +9       ;  MIFN=Movement IFN

 +10      ;  MV("AS")=while ASIH