- 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
