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 ---[H[J[2J[HDGPMGLG1 1860 printed Sep 23, 2025@20:25:31 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
