DGPMLOS.m

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 ---DGPMLOS   1641     printed  Apr 09, 2024@21:50:25                                                                                                                                                                                                     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