Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHMMNPRT

FHMMNPRT.m

Go to the documentation of this file.
  1. FHMMNPRT ;Hines OIFO/RTK,AAC - Mult Monitor Report Print ;02/08/06 10:29
  1. ;;5.5;DIETETICS;**4**;Jan 28, 2005;Build 32
  1. ;
  1. S (COUNT,COMM,CTCOMM,MON,ALLMON,ALLMON1,M1,M2,M3,M4,M5)=0
  1. S PG=0,(EX,XX)="" D NOW^%DTC S Y=X D DD^%DT S FHNDT=Y
  1. K FHMNTT
  1. ;
  1. PRINT ;
  1. S (MM1,MM2,MM3,MM4,MM5)=0
  1. D MNAME
  1. Q:XX="*"
  1. I FHNXIEN'="ALL" I '$D(^TMP($J,"FHDATA",COMM,FHNXIEN)) D MESSAGE Q
  1. I FHNXIEN'="ALL" S ZZ=FHNXIEN D DISP,D1END Q
  1. I FHNXIEN="ALL" S ZZ="" F S ZZ=$O(^TMP($J,"FHDATA",COMM,ZZ)) Q:ZZ=""!(EX=U) D
  1. .D PG
  1. .D DISP
  1. .S ALLMON=ALLMON+MON
  1. .S ALLMON1=ALLMON1+MON
  1. .S M1=M1+MON1,M2=M2+MON2,M3=M3+MON3,M4=M4+MON4,M5=M5+MON5
  1. .S MM1=MM1+MON1,MM2=MM2+MON2,MM3=MM3+MON3,MM4=MM4+MON4,MM5=MM5+MON5
  1. .Q
  1. I FHNXIEN'="ALL"!(EX=U) G END Q
  1. I ALLMON=0 W !!?5,"NO PATIENTS WITH MONITORS IN GIVEN DATE RANGE" D END Q
  1. ;
  1. W !!,"** TOTAL COMMUNICATIONS OFFICE - Admissions.....: ",NAME I $Y>(IOSL-4) D PG I EX=U Q
  1. ;
  1. W !!?16,"Totals for ALL ",$S(FHSORT="C":"Clinicians.......: ",1:"Wards............: "),$J(ALLMON1,3) I $Y>(IOSL-4) D PG I EX=U Q
  1. ;I ZCO'="Y",ALLMON1=0 G PRINT
  1. I ALLMON>0 W !?16,"Monitor: Albumin < 2.8..........: ",$J(MM1,3)," ",$J(((MM1/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
  1. I ALLMON>0 W !?16,"Monitor: BMI < 18.5...............: ",$J(MM2,3)," ",$J(((MM2/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
  1. I ALLMON>0 W !?16,"Monitor: NPO+Clr Liq > 3 days...: ",$J(MM3,3)," ",$J(((MM3/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
  1. I ALLMON>0 W !?16,"Monitor: On Hyperals............: ",$J(MM4,3)," ",$J(((MM4/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
  1. I ALLMON>0 W !?16,"Monitor: On Tubefeeding.........: ",$J(MM5,3)," ",$J(((MM5/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
  1. ;
  1. ;
  1. S (MM1,MM2,MM3,MM4,MM5,ALLMON1)=0
  1. G PRINT Q
  1. Q
  1. ;
  1. THEND ;
  1. S NAME="ALL COMMUNICATION OFFICES " D PG I EX=U Q
  1. W !!,"*** TOTAL PATIENTS WITH MONITORS ALL COMMUNICATION OFFICES....: ",CTCOMM
  1. ;
  1. W !!?16,"Totals for ALL ",$S(FHSORT="C":"Clinicians.......: ",1:"Wards............: "),$J(ALLMON,3)
  1. I ALLMON>0 W !?16,"Monitor: Albumin < 2.8..........: ",$J(M1,3)," ",$J(((M1/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
  1. I ALLMON>0 W !?16,"Monitor: BMI < 18.5...............: ",$J(M2,3)," ",$J(((M2/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
  1. I ALLMON>0 W !?16,"Monitor: NPO+Clr Liq > 3 days...: ",$J(M3,3)," ",$J(((M3/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
  1. I ALLMON>0 W !?16,"Monitor: On Hyperals............: ",$J(M4,3)," ",$J(((M4/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
  1. I ALLMON>0 W !?16,"Monitor: On Tubefeeding.........: ",$J(M5,3)," ",$J(((M5/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
  1. ;
  1. ;W !!!,"TOTAL ADMISSIONS....:",?23,FHTADM
  1. ;W !,"TOTAL MONITORS......:",?23,ALLMON
  1. ;I FHTADM>0 W !,"PERCENTAGE..........:",?23,$J(((ALLMON/FHTADM)*100),1,2),"%"
  1. D LINE
  1. S XX="*"
  1. Q
  1. ;I $Y>(IOSL-4)
  1. ;
  1. D1END W ! K DIR Q:EX'=U S DIR(0)="E" D ^DIR ;I IOST?1"C".E,EX'=U
  1. D END Q
  1. Q
  1. DISP ;
  1. S (TOT,MON,MON1,MON2,MON3,MON4,MON5)=0
  1. F YY=0:0 S YY=$O(^TMP($J,"FHDATA",COMM,ZZ,YY)) Q:YY'>0 D
  1. DISP2 .F HH=0:0 S HH=$O(^TMP($J,"FHDATA",COMM,ZZ,YY,HH)) Q:HH'>0!(EX=U) D
  1. ..I $Y>(IOSL-4) I EX=U Q W ! D HDR
  1. ..S CTCOMM=CTCOMM+1
  1. ..S DFN=$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,5)
  1. ..S Y=YY X ^DD("DD") W !,Y
  1. ..W ?13,$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,2)
  1. ..W ?39,$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,3)
  1. ..W ?47,$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,6)
  1. ..I $P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,7)="Yes" D
  1. ...F NUM=0:0 S NUM=$O(FHMON(DFN,HH,NUM)) Q:NUM'>0!(EX=U) D
  1. ....I NUM'=1 W !
  1. ....S MON=MON+1,MONTYP=$P($P(FHMON(DFN,HH,NUM),U,1),": ",2)
  1. ....S PC=$S(MONTYP["Albumin":1,MONTYP["BMI":2,MONTYP["NPO+Clr":3,MONTYP["Hyper":4,1:5)
  1. ....I $G(FHMNTT(COMM,ZZ))="" S FHMNTT(COMM,ZZ)=""
  1. ....S $P(FHMNTT(COMM,ZZ),U,PC)=$P(FHMNTT(COMM,ZZ),U,PC)+1
  1. ....W ?56,MONTYP I $Y>(IOSL-4) D PG I EX=U Q
  1. ....Q
  1. ...Q
  1. ..S TOT=TOT+1
  1. ..Q
  1. .Q
  1. I MON=0!(EX=U) Q
  1. I FHSORT="C" W !!,"* CLINICIAN: ",ZZ
  1. I FHSORT="W" W !!,"* WARD: ",ZZ
  1. W !?16,"Total Number of Monitors........: ",$J(MON,3) I $Y>(IOSL-4) D PG I EX=U Q
  1. S PCE=$P(FHMNTT(COMM,ZZ),U,1) I PCE>0 W !?16,"Monitor: Albumin < 2.8..........: ",$J(PCE,3)," ",$J(((PCE/MON)*100),1,2),"%" S MON1=PCE I $Y>(IOSL-4) D PG I EX=U Q
  1. S PCE=$P(FHMNTT(COMM,ZZ),U,2) I PCE>0 W !?16,"Monitor: BMI < 18.5...............: ",$J(PCE,3)," ",$J(((PCE/MON)*100),1,2),"%" S MON2=PCE I $Y>(IOSL-4) D PG I EX=U Q
  1. S PCE=$P(FHMNTT(COMM,ZZ),U,3) I PCE>0 W !?16,"Monitor: NPO+Clr Liq > 3 days...: ",$J(PCE,3)," ",$J(((PCE/MON)*100),1,2),"%" S MON3=PCE I $Y>(IOSL-4) D PG I EX=U Q
  1. S PCE=$P(FHMNTT(COMM,ZZ),U,4) I PCE>0 W !?16,"Monitor: On Hyperals............: ",$J(PCE,3)," ",$J(((PCE/MON)*100),1,2),"%" S MON4=PCE I $Y>(IOSL-4) D PG I EX=U Q
  1. S PCE=$P(FHMNTT(COMM,ZZ),U,5) I PCE>0 W !?16,"Monitor: On Tubefeeding.........: ",$J(PCE,3)," ",$J(((PCE/MON)*100),1,2),"%" S MON5=PCE
  1. W !
  1. Q
  1. ;
  1. MESSAGE ;
  1. W !!?5,"NO PATIENTS WITH MONITORS IN GIVEN DATE RANGE"
  1. W !?10,"FOR THIS ",$S(FHSORT="C":"CLINICIAN",1:"WARD"),": ",FHNXIEN
  1. Q
  1. END K FHMNTT,HH,M1,M2,M3,M4,M5,MON,MON1,MON2,MON3,MON4,MON5,MONTYP
  1. K NUM,PC,PCE,PG,PER,TOT,YY
  1. QUIT
  1. Q
  1. ;
  1. PG ;
  1. I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
  1. D HDR Q
  1. Q
  1. HDR ;Header
  1. W:$Y @IOF W !,FHNDT,?60,"Page: " S PG=PG+1 W PG,!
  1. W !,?25,"Nutrition Monitor Statistic Report"
  1. W !,NAME,!
  1. W "Admission",?13,"Patient",?39,"SSN",?45,"Status",?56,"Monitor(s)"
  1. LINE W ! F Z=1:1:79 W "="
  1. Q
  1. MNAME ;
  1. I ZCO'="Y" S CONUMX=CONUMX-1 G:CONUMX<1 THEND S COXX=$P(CO,"^",CONUMX),NAME=$P(CONAME,"^",CONUMX) S COMM=COXX Q
  1. I ZCO="Y" S COUNT=COUNT+1 G:COUNT>ZOUT THEND S NAME=$G(^FH(119.73,COUNT,0)),NAME=$P(NAME,"^") S COMM=COUNT
  1. I $D(^FH(119.73,COUNT,"I"))!'$D(^FH(119.73,COUNT,0)) G MNAME
  1. Q
  1. QUIT ;
  1. W !
  1. Q