ADGLOS.m

ADGLOS ; IHS/ADC/PDW/ENM - length of stay ; [ 03/25/1999  11:48 AM ]

 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 ;

 ; * returns Length of Stay with ward/service

 ;   DGPMDA - patient movement ifn   required

 ;

DW() ; -- discharge ward los

 N X,X1,X2,DGPMID,DGPMCA,DGPMN0,DG3

 I '$D(DGPMDA) Q 0

 S DGPMN0=^DGPM(DGPMDA,0),DGPMCA=$P(DGPMN0,U,14),DFN=$P(DGPMN0,U,3)

 S DG3=$P(^DGPM(DGPMCA,0),U,17) Q:'DG3 0

 S X1=+^DGPM(DG3,0),DGPMID=9999999.9999999-X1

 S DGPMID=$O(^DGPM("APMV",DFN,DGPMCA,DGPMID))

 S X=$O(^DGPM("APMV",DFN,DGPMCA,DGPMID,0))

 S X2=+^DGPM(+X,0) D ^%DTC

 Q $S(X:X,1:1)

 ;

DS() ; -- discharge service los

 N X,X1,X2,DGPMID,DGPMCA,DGPMN0,DG3

 I '$D(DGPMDA) Q 0

 S DGPMN0=^DGPM(DGPMDA,0),DGPMCA=$P(DGPMN0,U,14),DFN=$P(DGPMN0,U,3)

 S DG3=$P(^DGPM(DGPMCA,0),U,17) Q:'DG3 0

 S X1=+^DGPM(DG3,0),DGPMID=9999999.9999999-X1

 S DGPMID=$O(^DGPM("ATS",DFN,DGPMCA,DGPMID))

 S X=$O(^DGPM("ATS",DFN,DGPMCA,DGPMID,0))

 S X2=$O(^DGPM("ATS",DFN,DGPMCA,DGPMID,X,0))

 S X2=+^DGPM(+X2,0) D ^%DTC

 Q $S(X:X,1:1)

 ;

W() ; -- previous ward los

 N X,X1,X2,DGPMID,DGPMCA,DGPMN0

 I '$D(DGPMDA) Q 0

 S DGPMN0=^DGPM(DGPMDA,0),DGPMCA=$P(DGPMN0,U,14),DFN=$P(DGPMN0,U,3)

 Q:"^2^3^"'[("^"_$P(DGPMN0,U,2)_"^") 0

 S X1=+DGPMN0,DGPMID=9999999.9999999-X1

 S DGPMID=$O(^DGPM("APMV",DFN,DGPMCA,DGPMID))

 S X=$O(^DGPM("APMV",DFN,DGPMCA,DGPMID,0))

 S X2=+^DGPM(+X,0) D ^%DTC

 Q $S(X:X,1:1)

 ;

S() ; -- previous service los

 N X,X1,X2,DGPMID,DGPMCA,DGPMN0

 I '$D(DGPMDA) Q 0

 S DGPMN0=^DGPM(DGPMDA,0)

 Q:"^2^3^"'[("^"_$P(DGPMN0,U,2)_"^") 0

 I $P(DGPMN0,U,2)=3 Q $$DS

 S X=$O(^DGPM("APHY",DGPMDA,0)) Q:'X 0

 S DGPMN0=^DGPM(X,0),DGPMCA=$P(DGPMN0,U,14),DFN=$P(DGPMN0,U,3)

 S X1=+DGPMN0,DGPMID=9999999.9999999-X1

 S DGPMID=$O(^DGPM("ATS",DFN,DGPMCA,DGPMID))

 S X=$O(^DGPM("ATS",DFN,DGPMCA,DGPMID,0))

 S X2=$O(^DGPM("ATS",DFN,DGPMCA,DGPMID,X,0))

 S X2=+^DGPM(+X2,0) D ^%DTC

 Q $S(X:X,1:1)

ADGLOS    ; IHS/ADC/PDW/ENM - length of stay ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 +2       ;

 +3       ; * returns Length of Stay with ward/service

 +4       ;   DGPMDA - patient movement ifn   required

 +5       ;

DW()      ; -- discharge ward los

 +1        NEW X,X1,X2,DGPMID,DGPMCA,DGPMN0,DG3

 +2        IF '$DATA(DGPMDA)

               QUIT 0

 +3        SET DGPMN0=^DGPM(DGPMDA,0)

           SET DGPMCA=$PIECE(DGPMN0,U,14)

           SET DFN=$PIECE(DGPMN0,U,3)

 +4        SET DG3=$PIECE(^DGPM(DGPMCA,0),U,17)

           IF 'DG3

               QUIT 0

 +5        SET X1=+^DGPM(DG3,0)

           SET DGPMID=9999999.9999999-X1

 +6        SET DGPMID=$ORDER(^DGPM("APMV",DFN,DGPMCA,DGPMID))

 +7        SET X=$ORDER(^DGPM("APMV",DFN,DGPMCA,DGPMID,0))

 +8        SET X2=+^DGPM(+X,0)

           DO ^%DTC

 +9        QUIT $SELECT(X:X,1:1)

 +10      ;

DS()      ; -- discharge service los

 +1        NEW X,X1,X2,DGPMID,DGPMCA,DGPMN0,DG3

 +2        IF '$DATA(DGPMDA)

               QUIT 0

 +3        SET DGPMN0=^DGPM(DGPMDA,0)

           SET DGPMCA=$PIECE(DGPMN0,U,14)

           SET DFN=$PIECE(DGPMN0,U,3)

 +4        SET DG3=$PIECE(^DGPM(DGPMCA,0),U,17)

           IF 'DG3

               QUIT 0

 +5        SET X1=+^DGPM(DG3,0)

           SET DGPMID=9999999.9999999-X1

 +6        SET DGPMID=$ORDER(^DGPM("ATS",DFN,DGPMCA,DGPMID))

 +7        SET X=$ORDER(^DGPM("ATS",DFN,DGPMCA,DGPMID,0))

 +8        SET X2=$ORDER(^DGPM("ATS",DFN,DGPMCA,DGPMID,X,0))

 +9        SET X2=+^DGPM(+X2,0)

           DO ^%DTC

 +10       QUIT $SELECT(X:X,1:1)

 +11      ;

W()       ; -- previous ward los

 +1        NEW X,X1,X2,DGPMID,DGPMCA,DGPMN0

 +2        IF '$DATA(DGPMDA)

               QUIT 0

 +3        SET DGPMN0=^DGPM(DGPMDA,0)

           SET DGPMCA=$PIECE(DGPMN0,U,14)

           SET DFN=$PIECE(DGPMN0,U,3)

 +4        IF "^2^3^"'[("^"_$PIECE(DGPMN0,U,2)_"^")

               QUIT 0

 +5        SET X1=+DGPMN0

           SET DGPMID=9999999.9999999-X1

 +6        SET DGPMID=$ORDER(^DGPM("APMV",DFN,DGPMCA,DGPMID))

 +7        SET X=$ORDER(^DGPM("APMV",DFN,DGPMCA,DGPMID,0))

 +8        SET X2=+^DGPM(+X,0)

           DO ^%DTC

 +9        QUIT $SELECT(X:X,1:1)

 +10      ;

S()       ; -- previous service los

 +1        NEW X,X1,X2,DGPMID,DGPMCA,DGPMN0

 +2        IF '$DATA(DGPMDA)

               QUIT 0

 +3        SET DGPMN0=^DGPM(DGPMDA,0)

 +4        IF "^2^3^"'[("^"_$PIECE(DGPMN0,U,2)_"^")

               QUIT 0

 +5        IF $PIECE(DGPMN0,U,2)=3

               QUIT $$DS

 +6        SET X=$ORDER(^DGPM("APHY",DGPMDA,0))

           IF 'X

               QUIT 0

 +7        SET DGPMN0=^DGPM(X,0)

           SET DGPMCA=$PIECE(DGPMN0,U,14)

           SET DFN=$PIECE(DGPMN0,U,3)

 +8        SET X1=+DGPMN0

           SET DGPMID=9999999.9999999-X1

 +9        SET DGPMID=$ORDER(^DGPM("ATS",DFN,DGPMCA,DGPMID))

 +10       SET X=$ORDER(^DGPM("ATS",DFN,DGPMCA,DGPMID,0))

 +11       SET X2=$ORDER(^DGPM("ATS",DFN,DGPMCA,DGPMID,X,0))

 +12       SET X2=+^DGPM(+X2,0)

           DO ^%DTC

 +13       QUIT $SELECT(X:X,1:1)