FHMNADM ;Hines OIFO/JT,RTK - Dietetics Adm/Disc Monitor Report ;06/12/02 10:34
;;5.5;DIETETICS;;Jan 28, 2005
;
DATE ;sets date
;
; Check for multidivisional site
I $P($G(^FH(119.9,1,0)),U,20)'="N" D ^FHMMNADM Q
K %DT(0) 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 Q:Y<0
S FHEDT=Y
S DIR(0)="SA^A:Admissions;D:Discharges"
S DIR("A")="Select type of movement for this report: " D ^DIR
Q:Y["^"!(Y="") S TYP=Y
G DEV
;
EN ;get admission/monitor information
S PG=0,EX="",Y=DT X ^DD("DD") S FHNDT=Y D HDR
S MVTOT=0,MONTOT=0
S I=FHSDT F S I=$O(^DGPM("ATT1",I)) Q:'I!(I>FHEDT)!(EX=U) D
.S J=0 F S J=$O(^DGPM("ATT1",I,J)) Q:'J!(EX=U) D
..S ADM=J,ADMD=I D WRT Q
.Q
D END Q
;
WRT ;write info
;
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(ADMD,".") X ^DD("DD") W !,Y,?13,$E($P(^DPT(DFN,0),U,1),U,23)
W ?39,$E($P(^(0),U,9),6,9) S MVTOT=MVTOT+1
I $D(^FHPT(FHDFN,"A",ADM,"MO"))>9 W ?48,"Yes" S MONTOT=MONTOT+1
S Y=$P($P($G(^FHPT(FHDFN,"A",ADM,0)),U,14),".",1) I Y X ^DD("DD") W ?56,Y
Q
;
EN1 ;discharges
S PG=0,EX="",Y=DT X ^DD("DD") S FHNDT=Y D HDR
S MVTOT=0,MONTOT=0
S I=FHSDT F S I=$O(^DGPM("ATT3",I)) Q:'I!(I>FHEDT)!(EX=U) D
.S J=0 F S J=$O(^DGPM("ATT3",I,J)) Q:'J!(EX=U) D
..S ADM=$P(^DGPM(J,0),U,14)
..S ADMD=$P(^DGPM(ADM,0),U,1) D WRT Q
.Q
;
END ;end/kill/quit
;
I EX=U D KL Q
W !!,"TOTAL "_$S(TYP="A":"ADMISSIONS",TYP="D":"DISCHARGES")_": ",?22,MVTOT
W !,"TOTAL WITH MONITORS:",?22,MONTOT
S FHPER=0 I MONTOT>0,MVTOT>0 S FHPER=(MONTOT/MVTOT)*100
I $L($P(FHPER,".",2))>2 S FHPER=$P(FHPER,".",1)_"."_$E($P(FHPER,".",2),1,2)
W !,"Percentage of "
W $S(TYP="A":"Admissions",TYP="D":"Discharges")
W " with Monitors: ",FHPER,"%"
KL K I,J,FHDFN,DFN,SSN,MVTOT,MONTOT,FHPER,FHSDT,FHEDT,X,Y,PG,FHNDT,ADM
K TAG,TYP,DIR,%DT,ADDT Q
;
DEV ;get device and set up queue
S TAG=$S(TYP="A":"EN",TYP="D":"EN1")
K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
I '$D(IO("Q")) U IO D @TAG,^%ZISC Q
S ZTRTN=TAG_"^FHMNADM",ZTSAVE("FHSDT")="",ZTSAVE("FHEDT")=""
S ZTSAVE("TYP")="",ZTDESC="Dietetics Monitor Report" D ^%ZTLOAD
W !,"Task #",ZTSK
D ^%ZISC K %ZIS,IOP,FHSDT,FHEDT 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 !,"DIETETIC MONITOR REPORT (Monitoring "
W $S(TYP="A":"Admissions",TYP="D":"Discharges")_")"
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
FHMNADM ;Hines OIFO/JT,RTK - Dietetics Adm/Disc Monitor Report ;06/12/02 10:34
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 ;
DATE ;sets date
+1 ;
+2 ; Check for multidivisional site
+3 IF $PIECE($GET(^FH(119.9,1,0)),U,20)'="N"
DO ^FHMMNADM
QUIT
+4 KILL %DT(0)
SET %DT="AEPT"
SET %DT("A")="Enter beginning date: "
DO ^%DT
IF Y<0
QUIT
+5 SET FHSDT=Y
SET %DT(0)=FHSDT
SET %DT("A")="Enter ending date: "
DO ^%DT
IF Y<0
QUIT
+6 SET FHEDT=Y
+7 SET DIR(0)="SA^A:Admissions;D:Discharges"
+8 SET DIR("A")="Select type of movement for this report: "
DO ^DIR
+9 IF Y["^"!(Y="")
QUIT
SET TYP=Y
+10 GOTO DEV
+11 ;
EN ;get admission/monitor information
+1 SET PG=0
SET EX=""
SET Y=DT
XECUTE ^DD("DD")
SET FHNDT=Y
DO HDR
+2 SET MVTOT=0
SET MONTOT=0
+3 SET I=FHSDT
FOR
SET I=$ORDER(^DGPM("ATT1",I))
IF 'I!(I>FHEDT)!(EX=U)
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 ADM=J
SET ADMD=I
DO WRT
QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 DO END
QUIT
+8 ;
WRT ;write info
+1 ;
+2 SET DFN=$PIECE(^DGPM(J,0),U,3)
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+3 SET FHZ115="P"_DFN
DO CHECK^FHOMDPA
IF FHDFN=""
QUIT
+4 SET Y=$PIECE(ADMD,".")
XECUTE ^DD("DD")
WRITE !,Y,?13,$EXTRACT($PIECE(^DPT(DFN,0),U,1),U,23)
+5 WRITE ?39,$EXTRACT($PIECE(^(0),U,9),6,9)
SET MVTOT=MVTOT+1
+6 IF $DATA(^FHPT(FHDFN,"A",ADM,"MO"))>9
WRITE ?48,"Yes"
SET MONTOT=MONTOT+1
+7 SET Y=$PIECE($PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),U,14),".",1)
IF Y
XECUTE ^DD("DD")
WRITE ?56,Y
+8 QUIT
+9 ;
EN1 ;discharges
+1 SET PG=0
SET EX=""
SET Y=DT
XECUTE ^DD("DD")
SET FHNDT=Y
DO HDR
+2 SET MVTOT=0
SET MONTOT=0
+3 SET I=FHSDT
FOR
SET I=$ORDER(^DGPM("ATT3",I))
IF 'I!(I>FHEDT)!(EX=U)
QUIT
Begin DoDot:1
+4 SET J=0
FOR
SET J=$ORDER(^DGPM("ATT3",I,J))
IF 'J!(EX=U)
QUIT
Begin DoDot:2
+5 SET ADM=$PIECE(^DGPM(J,0),U,14)
+6 SET ADMD=$PIECE(^DGPM(ADM,0),U,1)
DO WRT
QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 ;
END ;end/kill/quit
+1 ;
+2 IF EX=U
DO KL
QUIT
+3 WRITE !!,"TOTAL "_$SELECT(TYP="A":"ADMISSIONS",TYP="D":"DISCHARGES")_": ",?22,MVTOT
+4 WRITE !,"TOTAL WITH MONITORS:",?22,MONTOT
+5 SET FHPER=0
IF MONTOT>0
IF MVTOT>0
SET FHPER=(MONTOT/MVTOT)*100
+6 IF $LENGTH($PIECE(FHPER,".",2))>2
SET FHPER=$PIECE(FHPER,".",1)_"."_$EXTRACT($PIECE(FHPER,".",2),1,2)
+7 WRITE !,"Percentage of "
+8 WRITE $SELECT(TYP="A":"Admissions",TYP="D":"Discharges")
+9 WRITE " with Monitors: ",FHPER,"%"
KL KILL I,J,FHDFN,DFN,SSN,MVTOT,MONTOT,FHPER,FHSDT,FHEDT,X,Y,PG,FHNDT,ADM
+1 KILL TAG,TYP,DIR,%DT,ADDT
QUIT
+2 ;
DEV ;get device and set up queue
+1 SET TAG=$SELECT(TYP="A":"EN",TYP="D":"EN1")
+2 KILL %ZIS,IOP
SET %ZIS="Q"
DO ^%ZIS
IF POP
QUIT
+3 IF '$DATA(IO("Q"))
USE IO
DO @TAG
DO ^%ZISC
QUIT
+4 SET ZTRTN=TAG_"^FHMNADM"
SET ZTSAVE("FHSDT")=""
SET ZTSAVE("FHEDT")=""
+5 SET ZTSAVE("TYP")=""
SET ZTDESC="Dietetics Monitor Report"
DO ^%ZTLOAD
+6 WRITE !,"Task #",ZTSK
+7 DO ^%ZISC
KILL %ZIS,IOP,FHSDT,FHEDT
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 ;
+2 IF $Y
WRITE @IOF
+3 WRITE !,"DIETETIC MONITOR REPORT (Monitoring "
+4 WRITE $SELECT(TYP="A":"Admissions",TYP="D":"Discharges")_")"
+5 WRITE !,FHNDT,?60,"Page: "
SET PG=PG+1
WRITE PG,!!
+6 WRITE "Admission",?13,"Patient",?39,"SSN",?45,"Monitor?",?56,"Discharge"
+7 WRITE !
FOR Z=1:1:79
WRITE "="
+8 QUIT
