ADGAD5 ; IHS/ADC/PDW/ENM - A&D UPDATE ADT CENSUS-TS ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
; Variables PD, RD used by VA G&L routines.
;
N TS,WD
A ; -- main
D ADU,PED,LOS Q
;
ADU ; -- adult ts
S TS=0 F S TS=$O(DGTSA(TS)) Q:'TS D
. Q:'$$AS S:'$D(^ADGTX(TS,0)) ^(0)=TS
. I '$D(^ADGTX(TS,1,RD)) D
.. S $P(^ADGTX(TS,1,0),U,3,4)=RD_U_($P($G(^(0)),U,4)+1)
. S ^ADGTX(TS,1,RD,0)=RD_U_$$PRA_U_DGTSA(TS) S:'$D(^(1)) ^(1)=""
Q
;
PED ; -- ped ts
S TS=0 F S TS=$O(DGTSP(TS)) Q:'TS D
. Q:'$$AS S:'$D(^ADGTX(TS,0)) ^(0)=TS
. I '$D(^ADGTX(TS,1,RD)) D
.. S $P(^ADGTX(TS,1,0),U,3,4)=RD_U_($P($G(^(0)),U,4)+1)
.. S ^ADGTX(TS,1,RD,0)=RD
. S ^ADGTX(TS,1,RD,1)=$$PRP_U_DGTSP(TS)
Q
;
LOS ; -- length of stay
;--ward
S WD=0 F S WD=$O(^ADGWD(WD)) Q:'WD D
. S:$D(^ADGWD(WD,1,RD,0))#2 $P(^(0),U,9)=DGLWD(WD)
. S:$D(^ADGWD(WD,1,RD,0))#2 $P(^(0),U,19)=DGLWD("NB",WD)
;--adult
S TS=0 F S TS=$O(^ADGTX(TS)) Q:'TS D
. Q:'$$AS S:$D(^ADGTX(TS,1,RD,0))#2 $P(^(0),U,9)=DGLTSA(TS)
;--ped
S TS=0 F S TS=$O(^ADGTX(TS)) Q:'TS D
. Q:'$$AS S:$D(^ADGTX(TS,1,RD,1))#2 $P(^(1),U,8)=DGLTSP(TS)
Q
;
PRAP() ; -- patients remaining, adult, previous
Q $P($G(^ADGTX(TS,1,PD,0)),U,2)
;
PRA() ; -- patients remaining, adult
N X S X=$$PRAP+$P(DGTSA(TS),U)-$P(DGTSA(TS),U,2)
Q X+$P(DGTSA(TS),U,3)-$P(DGTSA(TS),U,4)-$P(DGTSA(TS),U,5)
;
PRPP() ; -- patients remaining, ped, previous
Q $P($G(^ADGTX(TS,1,PD,1)),U)
;
PRP() ; -- patients remaining, ped
N X S X=$$PRPP+$P(DGTSP(TS),U)-$P(DGTSP(TS),U,2)
Q X+$P(DGTSP(TS),U,3)-$P(DGTSP(TS),U,4)-$P(DGTSP(TS),U,5)
;
AS() ; -- admitting service (yes=1, no=0)
Q $S($P($G(^DIC(45.7,+TS,9999999)),U,3)="Y":1,1:0)
ADGAD5 ; IHS/ADC/PDW/ENM - A&D UPDATE ADT CENSUS-TS ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 ; Variables PD, RD used by VA G&L routines.
+4 ;
+5 NEW TS,WD
A ; -- main
+1 DO ADU
DO PED
DO LOS
QUIT
+2 ;
ADU ; -- adult ts
+1 SET TS=0
FOR
SET TS=$ORDER(DGTSA(TS))
IF 'TS
QUIT
Begin DoDot:1
+2 IF '$$AS
QUIT
IF '$DATA(^ADGTX(TS,0))
SET ^(0)=TS
+3 IF '$DATA(^ADGTX(TS,1,RD))
Begin DoDot:2
+4 SET $PIECE(^ADGTX(TS,1,0),U,3,4)=RD_U_($PIECE($GET(^(0)),U,4)+1)
End DoDot:2
+5 SET ^ADGTX(TS,1,RD,0)=RD_U_$$PRA_U_DGTSA(TS)
IF '$DATA(^(1))
SET ^(1)=""
End DoDot:1
+6 QUIT
+7 ;
PED ; -- ped ts
+1 SET TS=0
FOR
SET TS=$ORDER(DGTSP(TS))
IF 'TS
QUIT
Begin DoDot:1
+2 IF '$$AS
QUIT
IF '$DATA(^ADGTX(TS,0))
SET ^(0)=TS
+3 IF '$DATA(^ADGTX(TS,1,RD))
Begin DoDot:2
+4 SET $PIECE(^ADGTX(TS,1,0),U,3,4)=RD_U_($PIECE($GET(^(0)),U,4)+1)
+5 SET ^ADGTX(TS,1,RD,0)=RD
End DoDot:2
+6 SET ^ADGTX(TS,1,RD,1)=$$PRP_U_DGTSP(TS)
End DoDot:1
+7 QUIT
+8 ;
LOS ; -- length of stay
+1 ;--ward
+2 SET WD=0
FOR
SET WD=$ORDER(^ADGWD(WD))
IF 'WD
QUIT
Begin DoDot:1
+3 IF $DATA(^ADGWD(WD,1,RD,0))#2
SET $PIECE(^(0),U,9)=DGLWD(WD)
+4 IF $DATA(^ADGWD(WD,1,RD,0))#2
SET $PIECE(^(0),U,19)=DGLWD("NB",WD)
End DoDot:1
+5 ;--adult
+6 SET TS=0
FOR
SET TS=$ORDER(^ADGTX(TS))
IF 'TS
QUIT
Begin DoDot:1
+7 IF '$$AS
QUIT
IF $DATA(^ADGTX(TS,1,RD,0))#2
SET $PIECE(^(0),U,9)=DGLTSA(TS)
End DoDot:1
+8 ;--ped
+9 SET TS=0
FOR
SET TS=$ORDER(^ADGTX(TS))
IF 'TS
QUIT
Begin DoDot:1
+10 IF '$$AS
QUIT
IF $DATA(^ADGTX(TS,1,RD,1))#2
SET $PIECE(^(1),U,8)=DGLTSP(TS)
End DoDot:1
+11 QUIT
+12 ;
PRAP() ; -- patients remaining, adult, previous
+1 QUIT $PIECE($GET(^ADGTX(TS,1,PD,0)),U,2)
+2 ;
PRA() ; -- patients remaining, adult
+1 NEW X
SET X=$$PRAP+$P(DGTSA(TS),U)-$PIECE(DGTSA(TS),U,2)
+2 QUIT X+$PIECE(DGTSA(TS),U,3)-$PIECE(DGTSA(TS),U,4)-$PIECE(DGTSA(TS),U,5)
+3 ;
PRPP() ; -- patients remaining, ped, previous
+1 QUIT $PIECE($GET(^ADGTX(TS,1,PD,1)),U)
+2 ;
PRP() ; -- patients remaining, ped
+1 NEW X
SET X=$$PRPP+$P(DGTSP(TS),U)-$PIECE(DGTSP(TS),U,2)
+2 QUIT X+$PIECE(DGTSP(TS),U,3)-$PIECE(DGTSP(TS),U,4)-$PIECE(DGTSP(TS),U,5)
+3 ;
AS() ; -- admitting service (yes=1, no=0)
+1 QUIT $SELECT($PIECE($GET(^DIC(45.7,+TS,9999999)),U,3)="Y":1,1:0)
