- 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 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