- DGPMLOS ;ALB/MIR - DETERMINE LOS FOR ADMISSION EPISODE; 8 FEB 90
- ;;5.3;Registration;;Aug 13, 1993
- ;
- ;INPUT: DGPMIFN = IFN of admission movement for which you want LOS to
- ; be calculated.
- ;OUTPUT: X = TOTAL ELAPSED TIME_"^"_TIME ON ABSENCE_"^"_TIME ON PASS_"^"_TIME ASIH_"^"_ACTUAL LENGTH OF STAY
- ;
- N A,D,DFN,DGE,DGS,I,X1,X2 S (LOP,LOA,LOAS)=0
- I $S('$D(DGPMIFN):1,'$D(^DGPM(+DGPMIFN,0)):1,$P(^(0),"^",2)'=1:1,1:0) S X="0^0^0^0^0" G Q
- D NOW^%DTC S X=^DGPM(+DGPMIFN,0),DFN=$P(^(0),"^",3),(X2,A)=+X,D=$S($D(^DGPM(+$P(X,"^",17),0)):+^(0),1:""),(X1,D)=$S('D:%,D>%:%,1:D)
- D ^%DTC S LOS=$S(X:X,1:1) ;LOS = elapsed time between admission and discharge (or NOW)
- F I=A:0 S I=$O(^DGPM("APCA",DFN,DGPMIFN,I)) Q:'I S DGS=$O(^(I,0)) I $D(^DGPM(+DGS,0)) S DGS=^(0) I "^1^2^3^13^43^44^45^"[("^"_$P(DGS,"^",18)_"^") S X2=+DGS,DGS=$P(DGS,"^",18) D ABS Q:'I
- S X=LOS_"^"_LOA_"^"_LOP_"^"_LOAS_"^"_(LOS-LOA-LOAS)
- Q K LOS,LOA,LOP,LOAS Q
- ABS ;if patient was out on absence, find return
- ;DGS = mvt type at start of absence
- ;DGE = mvt type at end of absence
- S X1=0 F I=I:0 S I=$O(^DGPM("APCA",DFN,DGPMIFN,I)) Q:'I S DGE=$O(^(I,0)) I $D(^DGPM(+DGE,0)) S DGE=^(0) I "^14^22^23^24^"[("^"_$P(DGE,"^",18)_"^") S X1=+DGE,DGE=$P(DGE,"^",18) Q
- I 'X1 S X1=D ;if no return from absence, use discharge or NOW
- D ^%DTC S X=$S(X:X,1:1) I DGS=1,$S('$D(DGE):1,DGE'=25:1,1:0) S LOP=LOP+X Q ;if TO AA <96, but not FROM AA<96, count as absence, not pass
- I "^1^2^3^25^26^"[("^"_DGS_"^") S LOA=LOA+X Q
- S LOAS=LOAS+X Q
- ;
- EN ;Entry point for computed fields in 405
- Q:$P(^DGPM(D0,0),U,2)'=1 S DGPMIFN=D0 D DGPMLOS
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMLOS 1641 printed Feb 19, 2025@00:15:48 Page 2
- DGPMLOS ;ALB/MIR - DETERMINE LOS FOR ADMISSION EPISODE; 8 FEB 90
- +1 ;;5.3;Registration;;Aug 13, 1993
- +2 ;
- +3 ;INPUT: DGPMIFN = IFN of admission movement for which you want LOS to
- +4 ; be calculated.
- +5 ;OUTPUT: X = TOTAL ELAPSED TIME_"^"_TIME ON ABSENCE_"^"_TIME ON PASS_"^"_TIME ASIH_"^"_ACTUAL LENGTH OF STAY
- +6 ;
- +7 NEW A,D,DFN,DGE,DGS,I,X1,X2
- SET (LOP,LOA,LOAS)=0
- +8 IF $SELECT('$DATA(DGPMIFN):1,'$DATA(^DGPM(+DGPMIFN,0)):1,$PIECE(^(0),"^",2)'=1:1,1:0)
- SET X="0^0^0^0^0"
- GOTO Q
- +9 DO NOW^%DTC
- SET X=^DGPM(+DGPMIFN,0)
- SET DFN=$PIECE(^(0),"^",3)
- SET (X2,A)=+X
- SET D=$SELECT($DATA(^DGPM(+$PIECE(X,"^",17),0)):+^(0),1:"")
- SET (X1,D)=$SELECT('D:%,D>%:%,1:D)
- +10 ;LOS = elapsed time between admission and discharge (or NOW)
- DO ^%DTC
- SET LOS=$SELECT(X:X,1:1)
- +11 FOR I=A:0
- SET I=$ORDER(^DGPM("APCA",DFN,DGPMIFN,I))
- if 'I
- QUIT
- SET DGS=$ORDER(^(I,0))
- IF $DATA(^DGPM(+DGS,0))
- SET DGS=^(0)
- IF "^1^2^3^13^43^44^45^"[("^"_$PIECE(DGS,"^",18)_"^")
- SET X2=+DGS
- SET DGS=$PIECE(DGS,"^",18)
- DO ABS
- if 'I
- QUIT
- +12 SET X=LOS_"^"_LOA_"^"_LOP_"^"_LOAS_"^"_(LOS-LOA-LOAS)
- Q KILL LOS,LOA,LOP,LOAS
- QUIT
- ABS ;if patient was out on absence, find return
- +1 ;DGS = mvt type at start of absence
- +2 ;DGE = mvt type at end of absence
- +3 SET X1=0
- FOR I=I:0
- SET I=$ORDER(^DGPM("APCA",DFN,DGPMIFN,I))
- if 'I
- QUIT
- SET DGE=$ORDER(^(I,0))
- IF $DATA(^DGPM(+DGE,0))
- SET DGE=^(0)
- IF "^14^22^23^24^"[("^"_$PIECE(DGE,"^",18)_"^")
- SET X1=+DGE
- SET DGE=$PIECE(DGE,"^",18)
- QUIT
- +4 ;if no return from absence, use discharge or NOW
- IF 'X1
- SET X1=D
- +5 ;if TO AA <96, but not FROM AA<96, count as absence, not pass
- DO ^%DTC
- SET X=$SELECT(X:X,1:1)
- IF DGS=1
- IF $SELECT('$DATA(DGE):1,DGE'=25:1,1:0)
- SET LOP=LOP+X
- QUIT
- +6 IF "^1^2^3^25^26^"[("^"_DGS_"^")
- SET LOA=LOA+X
- QUIT
- +7 SET LOAS=LOAS+X
- QUIT
- +8 ;
- EN ;Entry point for computed fields in 405
- +1 if $PIECE(^DGPM(D0,0),U,2)'=1
- QUIT
- SET DGPMIFN=D0
- DO DGPMLOS
- +2 QUIT