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