FHMNBRPT ;Hines OIFO/JT,RTK - Dietetics Monitor Brief ;07/26/01 11:49
;;5.5;DIETETICS;**2**;Jan 28, 2005
;
DATE ;sets date
; Check for multidivisional site
I $P($G(^FH(119.9,1,0)),U,20)'="N" D ^FHMMBRPT Q
W ! S %DT="AEPT",%DT("A")="Enter beginning date: " D ^%DT Q:Y<0
S FHSDT=Y,%DT(0)=FHSDT,%DT("A")="Enter ending date: " D ^%DT K %DT(0)
I Y<0 D END Q
S FHEDT=Y D DEV
D END Q
;
EN ;get admission/monitor information
S PG=0,EX="" D NOW^%DTC S Y=X D DD^%DT S FHNDT=Y D HDR
S ADMTOT=0,MONTOT=0
S I=FHSDT F S I=$O(^DGPM("ATT1",I)) Q:'I!(I>FHEDT) D
.S J=0 F S J=$O(^DGPM("ATT1",I,J)) Q:'J!(EX=U) D
..S DFN=$P(^DGPM(J,0),U,3) I $Y>(IOSL-4) D PG I EX=U Q
..S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
..S Y=$P(I,".") X ^DD("DD") W !,Y,?13,$E($P(^DPT(DFN,0),U,1),1,23)
..W ?39,$E($P(^DPT(DFN,0),U,9),6,9) S ADMTOT=ADMTOT+1
..I $D(^FHPT(FHDFN,"A",J,"MO","B")) W ?48,"Yes" S MONTOT=MONTOT+1
..S Y=$P($P($G(^FHPT(FHDFN,"A",J,0)),U,14),".",1) I Y X ^DD("DD") W ?56,Y
..Q
.Q
I EX=U D END Q
W !!,"TOTAL ADMISSIONS: ",?22,ADMTOT
W !,"TOTAL WITH MONITORS:",?22,MONTOT
W !,"Percentage of Admissions with Monitors: "
I ADMTOT=0!(MONTOT=0) W "0.0%" D END Q
S FHPER=(MONTOT/ADMTOT)*100
I $L($P(FHPER,".",2))>2 S FHPER=$P(FHPER,".",1)_"."_$E($P(FHPER,".",2),1,2)
W FHPER,"%"
I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR
D END Q
DEV ;get device and set up queue
W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
I '$D(IO("Q")) U IO D EN,^%ZISC,END Q
S ZTRTN="EN^FHMNBRPT",ZTSAVE("FHSDT")="",ZTSAVE("FHEDT")=""
S ZTSAVE=("FHNDT"),ZTSAVE=("FHPER")
S ZTDESC="Dietetics Monitor Report" D ^%ZTLOAD
D ^%ZISC K %ZIS,IOP
D END Q
END ;kill and quit
K I,J,FHDFN,DFN,SSN,ADMTOT,MONTOT,FHPER,FHSDT,FHEDT,FHNDT,X,Y,PG
Q
PG ;
I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
D HDR Q
HDR ;Header
W:$Y @IOF W !,FHNDT,?60,"Page: " S PG=PG+1 W PG,!!
W "Admission",?13,"Patient",?39,"SSN",?45,"Monitor?",?56,"Discharge"
W ! F Z=1:1:79 W "="
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHMNBRPT 2009 printed Dec 13, 2024@01:47:59 Page 2
FHMNBRPT ;Hines OIFO/JT,RTK - Dietetics Monitor Brief ;07/26/01 11:49
+1 ;;5.5;DIETETICS;**2**;Jan 28, 2005
+2 ;
DATE ;sets date
+1 ; Check for multidivisional site
+2 IF $PIECE($GET(^FH(119.9,1,0)),U,20)'="N"
DO ^FHMMBRPT
QUIT
+3 WRITE !
SET %DT="AEPT"
SET %DT("A")="Enter beginning date: "
DO ^%DT
if Y<0
QUIT
+4 SET FHSDT=Y
SET %DT(0)=FHSDT
SET %DT("A")="Enter ending date: "
DO ^%DT
KILL %DT(0)
+5 IF Y<0
DO END
QUIT
+6 SET FHEDT=Y
DO DEV
+7 DO END
QUIT
+8 ;
EN ;get admission/monitor information
+1 SET PG=0
SET EX=""
DO NOW^%DTC
SET Y=X
DO DD^%DT
SET FHNDT=Y
DO HDR
+2 SET ADMTOT=0
SET MONTOT=0
+3 SET I=FHSDT
FOR
SET I=$ORDER(^DGPM("ATT1",I))
if 'I!(I>FHEDT)
QUIT
Begin DoDot:1
+4 SET J=0
FOR
SET J=$ORDER(^DGPM("ATT1",I,J))
if 'J!(EX=U)
QUIT
Begin DoDot:2
+5 SET DFN=$PIECE(^DGPM(J,0),U,3)
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+6 SET FHZ115="P"_DFN
DO CHECK^FHOMDPA
IF FHDFN=""
QUIT
+7 SET Y=$PIECE(I,".")
XECUTE ^DD("DD")
WRITE !,Y,?13,$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,23)
+8 WRITE ?39,$EXTRACT($PIECE(^DPT(DFN,0),U,9),6,9)
SET ADMTOT=ADMTOT+1
+9 IF $DATA(^FHPT(FHDFN,"A",J,"MO","B"))
WRITE ?48,"Yes"
SET MONTOT=MONTOT+1
+10 SET Y=$PIECE($PIECE($GET(^FHPT(FHDFN,"A",J,0)),U,14),".",1)
IF Y
XECUTE ^DD("DD")
WRITE ?56,Y
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 IF EX=U
DO END
QUIT
+14 WRITE !!,"TOTAL ADMISSIONS: ",?22,ADMTOT
+15 WRITE !,"TOTAL WITH MONITORS:",?22,MONTOT
+16 WRITE !,"Percentage of Admissions with Monitors: "
+17 IF ADMTOT=0!(MONTOT=0)
WRITE "0.0%"
DO END
QUIT
+18 SET FHPER=(MONTOT/ADMTOT)*100
+19 IF $LENGTH($PIECE(FHPER,".",2))>2
SET FHPER=$PIECE(FHPER,".",1)_"."_$EXTRACT($PIECE(FHPER,".",2),1,2)
+20 WRITE FHPER,"%"
+21 IF IOST?1"C".E
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
+22 DO END
QUIT
DEV ;get device and set up queue
+1 WRITE !
KILL %ZIS,IOP
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+2 IF '$DATA(IO("Q"))
USE IO
DO EN
DO ^%ZISC
DO END
QUIT
+3 SET ZTRTN="EN^FHMNBRPT"
SET ZTSAVE("FHSDT")=""
SET ZTSAVE("FHEDT")=""
+4 SET ZTSAVE=("FHNDT")
SET ZTSAVE=("FHPER")
+5 SET ZTDESC="Dietetics Monitor Report"
DO ^%ZTLOAD
+6 DO ^%ZISC
KILL %ZIS,IOP
+7 DO END
QUIT
END ;kill and quit
+1 KILL I,J,FHDFN,DFN,SSN,ADMTOT,MONTOT,FHPER,FHSDT,FHEDT,FHNDT,X,Y,PG
+2 QUIT
PG ;
+1 IF IOST?1"C".E
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET EX=U
QUIT
+2 DO HDR
QUIT
HDR ;Header
+1 if $Y
WRITE @IOF
WRITE !,FHNDT,?60,"Page: "
SET PG=PG+1
WRITE PG,!!
+2 WRITE "Admission",?13,"Patient",?39,"SSN",?45,"Monitor?",?56,"Discharge"
+3 WRITE !
FOR Z=1:1:79
WRITE "="
+4 QUIT
