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