ADGPCU ; IHS/ADC/PDW/ENM - PCU ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
W @IOF,!!!?18,"PCU STATS",!!
A ; -- driver
D BD I Y=-1 D Q Q
D ED I Y=-1 D Q Q
D ZIS I POP D Q Q
I $D(IO("Q")) D QUE,Q Q
D D,Q Q
;
BD ; -- beginning date
S %DT="AEQ",%DT("A")="Select beginning date: ",X="" D ^%DT S DGBD=Y Q
;
ED ; -- ending date
S %DT="AEQ",%DT("A")="Select ending date: ",X="" D ^%DT S DGED=Y Q
;
ZIS ; -- select device
S %ZIS="PQ" D ^%ZIS Q
;
QUE K IO("Q") S ZTRTN="D^ADGPCU",ZTDESC="PCU STATS"
S ZTSAVE("DGBD")="",ZTSAVE("DGED")="" D ^%ZTLOAD D ^%ZISC K ZTSK Q
;
Q K DGBD,DGED,X,Y D HOME^%ZIS Q
;
D ; -- queued entry point
D L,Q Q
;
L ; -- loop
N ICU,PCU,D,C,N,I
S C=0,D=DGBD F S D=$O(^DGPM("B",D)) Q:'D Q:D>DGED D
. S I=0 F S I=$O(^DGPM("B",D,I)) Q:'I D
.. S N=$G(^DGPM(+I,0)) Q:'N
.. W:$P(N,U,6)=5 !,N
.. I $P(N,U,6)=5,$P($G(^DGPM(+$O(^DGPM("APHY",I,0)),0)),U,9)=9 D Q
... S PCU(+$P(N,U,2))=$G(PCU(+$P(N,U,2)))+1
.. I $P(N,U,6)=6,$P($G(^DGPM(+$O(^DGPM("APHY",I,0)),0)),U,9)=9 D Q
... S ICU(+$P(N,U,2))=$G(ICU(+$P(N,U,2)))+1
.. I $P(N,U,6)=5,'$O(^DGPM("APHY",I,0)),$$T D Q
... S PCU(+$P(N,U,2))=$G(PCU(+$P(N,U,2)))+1
.. I $P(N,U,6)=6,'$O(^DGPM("APHY",I,0)),$$T D Q
... S ICU(+$P(N,U,2))=$G(ICU(+$P(N,U,2)))+1
Q
;
T() ;
N ID,T S ID=9999999.9999999-D
S ID=$O(^DGPM("ATS",+$P(N,U,3),+$P(N,U,14),ID)) Q:'ID 0
S T=$O(^DGPM("ATS",+$P(N,U,3),+$P(N,U,14),ID,0)) Q $S(T=9:T,1:0)
ADGPCU ; IHS/ADC/PDW/ENM - PCU ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
+3 WRITE @IOF,!!!?18,"PCU STATS",!!
A ; -- driver
+1 DO BD
IF Y=-1
DO Q
QUIT
+2 DO ED
IF Y=-1
DO Q
QUIT
+3 DO ZIS
IF POP
DO Q
QUIT
+4 IF $DATA(IO("Q"))
DO QUE
DO Q
QUIT
+5 DO D
DO Q
QUIT
+6 ;
BD ; -- beginning date
+1 SET %DT="AEQ"
SET %DT("A")="Select beginning date: "
SET X=""
DO ^%DT
SET DGBD=Y
QUIT
+2 ;
ED ; -- ending date
+1 SET %DT="AEQ"
SET %DT("A")="Select ending date: "
SET X=""
DO ^%DT
SET DGED=Y
QUIT
+2 ;
ZIS ; -- select device
+1 SET %ZIS="PQ"
DO ^%ZIS
QUIT
+2 ;
QUE KILL IO("Q")
SET ZTRTN="D^ADGPCU"
SET ZTDESC="PCU STATS"
+1 SET ZTSAVE("DGBD")=""
SET ZTSAVE("DGED")=""
DO ^%ZTLOAD
DO ^%ZISC
KILL ZTSK
QUIT
+2 ;
Q KILL DGBD,DGED,X,Y
DO HOME^%ZIS
QUIT
+1 ;
D ; -- queued entry point
+1 DO L
DO Q
QUIT
+2 ;
L ; -- loop
+1 NEW ICU,PCU,D,C,N,I
+2 SET C=0
SET D=DGBD
FOR
SET D=$ORDER(^DGPM("B",D))
IF 'D
QUIT
IF D>DGED
QUIT
Begin DoDot:1
+3 SET I=0
FOR
SET I=$ORDER(^DGPM("B",D,I))
IF 'I
QUIT
Begin DoDot:2
+4 SET N=$GET(^DGPM(+I,0))
IF 'N
QUIT
+5 IF $PIECE(N,U,6)=5
WRITE !,N
+6 IF $PIECE(N,U,6)=5
IF $PIECE($GET(^DGPM(+$ORDER(^DGPM("APHY",I,0)),0)),U,9)=9
Begin DoDot:3
+7 SET PCU(+$PIECE(N,U,2))=$GET(PCU(+$PIECE(N,U,2)))+1
End DoDot:3
QUIT
+8 IF $PIECE(N,U,6)=6
IF $PIECE($GET(^DGPM(+$ORDER(^DGPM("APHY",I,0)),0)),U,9)=9
Begin DoDot:3
+9 SET ICU(+$PIECE(N,U,2))=$GET(ICU(+$PIECE(N,U,2)))+1
End DoDot:3
QUIT
+10 IF $PIECE(N,U,6)=5
IF '$ORDER(^DGPM("APHY",I,0))
IF $$T
Begin DoDot:3
+11 SET PCU(+$PIECE(N,U,2))=$GET(PCU(+$PIECE(N,U,2)))+1
End DoDot:3
QUIT
+12 IF $PIECE(N,U,6)=6
IF '$ORDER(^DGPM("APHY",I,0))
IF $$T
Begin DoDot:3
+13 SET ICU(+$PIECE(N,U,2))=$GET(ICU(+$PIECE(N,U,2)))+1
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
T() ;
+1 NEW ID,T
SET ID=9999999.9999999-D
+2 SET ID=$ORDER(^DGPM("ATS",+$PIECE(N,U,3),+$PIECE(N,U,14),ID))
IF 'ID
QUIT 0
+3 SET T=$ORDER(^DGPM("ATS",+$PIECE(N,U,3),+$PIECE(N,U,14),ID,0))
QUIT $SELECT(T=9:T,1:0)
