FHMMNPRT ;Hines OIFO/RTK,AAC - Mult Monitor Report Print ;02/08/06 10:29
;;5.5;DIETETICS;**4**;Jan 28, 2005;Build 32
;
S (COUNT,COMM,CTCOMM,MON,ALLMON,ALLMON1,M1,M2,M3,M4,M5)=0
S PG=0,(EX,XX)="" D NOW^%DTC S Y=X D DD^%DT S FHNDT=Y
K FHMNTT
;
PRINT ;
S (MM1,MM2,MM3,MM4,MM5)=0
D MNAME
Q:XX="*"
I FHNXIEN'="ALL" I '$D(^TMP($J,"FHDATA",COMM,FHNXIEN)) D MESSAGE Q
I FHNXIEN'="ALL" S ZZ=FHNXIEN D DISP,D1END Q
I FHNXIEN="ALL" S ZZ="" F S ZZ=$O(^TMP($J,"FHDATA",COMM,ZZ)) Q:ZZ=""!(EX=U) D
.D PG
.D DISP
.S ALLMON=ALLMON+MON
.S ALLMON1=ALLMON1+MON
.S M1=M1+MON1,M2=M2+MON2,M3=M3+MON3,M4=M4+MON4,M5=M5+MON5
.S MM1=MM1+MON1,MM2=MM2+MON2,MM3=MM3+MON3,MM4=MM4+MON4,MM5=MM5+MON5
.Q
I FHNXIEN'="ALL"!(EX=U) G END Q
I ALLMON=0 W !!?5,"NO PATIENTS WITH MONITORS IN GIVEN DATE RANGE" D END Q
;
W !!,"** TOTAL COMMUNICATIONS OFFICE - Admissions.....: ",NAME I $Y>(IOSL-4) D PG I EX=U Q
;
W !!?16,"Totals for ALL ",$S(FHSORT="C":"Clinicians.......: ",1:"Wards............: "),$J(ALLMON1,3) I $Y>(IOSL-4) D PG I EX=U Q
;I ZCO'="Y",ALLMON1=0 G PRINT
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
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
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
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
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
;
;
S (MM1,MM2,MM3,MM4,MM5,ALLMON1)=0
G PRINT Q
Q
;
THEND ;
S NAME="ALL COMMUNICATION OFFICES " D PG I EX=U Q
W !!,"*** TOTAL PATIENTS WITH MONITORS ALL COMMUNICATION OFFICES....: ",CTCOMM
;
W !!?16,"Totals for ALL ",$S(FHSORT="C":"Clinicians.......: ",1:"Wards............: "),$J(ALLMON,3)
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
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
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
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
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
;
;W !!!,"TOTAL ADMISSIONS....:",?23,FHTADM
;W !,"TOTAL MONITORS......:",?23,ALLMON
;I FHTADM>0 W !,"PERCENTAGE..........:",?23,$J(((ALLMON/FHTADM)*100),1,2),"%"
D LINE
S XX="*"
Q
;I $Y>(IOSL-4)
;
D1END W ! K DIR Q:EX'=U S DIR(0)="E" D ^DIR ;I IOST?1"C".E,EX'=U
D END Q
Q
DISP ;
S (TOT,MON,MON1,MON2,MON3,MON4,MON5)=0
F YY=0:0 S YY=$O(^TMP($J,"FHDATA",COMM,ZZ,YY)) Q:YY'>0 D
DISP2 .F HH=0:0 S HH=$O(^TMP($J,"FHDATA",COMM,ZZ,YY,HH)) Q:HH'>0!(EX=U) D
..I $Y>(IOSL-4) I EX=U Q W ! D HDR
..S CTCOMM=CTCOMM+1
..S DFN=$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,5)
..S Y=YY X ^DD("DD") W !,Y
..W ?13,$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,2)
..W ?39,$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,3)
..W ?47,$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,6)
..I $P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,7)="Yes" D
...F NUM=0:0 S NUM=$O(FHMON(DFN,HH,NUM)) Q:NUM'>0!(EX=U) D
....I NUM'=1 W !
....S MON=MON+1,MONTYP=$P($P(FHMON(DFN,HH,NUM),U,1),": ",2)
....S PC=$S(MONTYP["Albumin":1,MONTYP["BMI":2,MONTYP["NPO+Clr":3,MONTYP["Hyper":4,1:5)
....I $G(FHMNTT(COMM,ZZ))="" S FHMNTT(COMM,ZZ)=""
....S $P(FHMNTT(COMM,ZZ),U,PC)=$P(FHMNTT(COMM,ZZ),U,PC)+1
....W ?56,MONTYP I $Y>(IOSL-4) D PG I EX=U Q
....Q
...Q
..S TOT=TOT+1
..Q
.Q
I MON=0!(EX=U) Q
I FHSORT="C" W !!,"* CLINICIAN: ",ZZ
I FHSORT="W" W !!,"* WARD: ",ZZ
W !?16,"Total Number of Monitors........: ",$J(MON,3) I $Y>(IOSL-4) D PG I EX=U Q
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
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
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
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
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
W !
Q
;
MESSAGE ;
W !!?5,"NO PATIENTS WITH MONITORS IN GIVEN DATE RANGE"
W !?10,"FOR THIS ",$S(FHSORT="C":"CLINICIAN",1:"WARD"),": ",FHNXIEN
Q
END K FHMNTT,HH,M1,M2,M3,M4,M5,MON,MON1,MON2,MON3,MON4,MON5,MONTYP
K NUM,PC,PCE,PG,PER,TOT,YY
QUIT
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
Q
HDR ;Header
W:$Y @IOF W !,FHNDT,?60,"Page: " S PG=PG+1 W PG,!
W !,?25,"Nutrition Monitor Statistic Report"
W !,NAME,!
W "Admission",?13,"Patient",?39,"SSN",?45,"Status",?56,"Monitor(s)"
LINE W ! F Z=1:1:79 W "="
Q
MNAME ;
I ZCO'="Y" S CONUMX=CONUMX-1 G:CONUMX<1 THEND S COXX=$P(CO,"^",CONUMX),NAME=$P(CONAME,"^",CONUMX) S COMM=COXX Q
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
I $D(^FH(119.73,COUNT,"I"))!'$D(^FH(119.73,COUNT,0)) G MNAME
Q
QUIT ;
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHMMNPRT 5854 printed Apr 09, 2024@20:57:42 Page 2
FHMMNPRT ;Hines OIFO/RTK,AAC - Mult Monitor Report Print ;02/08/06 10:29
+1 ;;5.5;DIETETICS;**4**;Jan 28, 2005;Build 32
+2 ;
+3 SET (COUNT,COMM,CTCOMM,MON,ALLMON,ALLMON1,M1,M2,M3,M4,M5)=0
+4 SET PG=0
SET (EX,XX)=""
DO NOW^%DTC
SET Y=X
DO DD^%DT
SET FHNDT=Y
+5 KILL FHMNTT
+6 ;
PRINT ;
+1 SET (MM1,MM2,MM3,MM4,MM5)=0
+2 DO MNAME
+3 if XX="*"
QUIT
+4 IF FHNXIEN'="ALL"
IF '$DATA(^TMP($JOB,"FHDATA",COMM,FHNXIEN))
DO MESSAGE
QUIT
+5 IF FHNXIEN'="ALL"
SET ZZ=FHNXIEN
DO DISP
DO D1END
QUIT
+6 IF FHNXIEN="ALL"
SET ZZ=""
FOR
SET ZZ=$ORDER(^TMP($JOB,"FHDATA",COMM,ZZ))
if ZZ=""!(EX=U)
QUIT
Begin DoDot:1
+7 DO PG
+8 DO DISP
+9 SET ALLMON=ALLMON+MON
+10 SET ALLMON1=ALLMON1+MON
+11 SET M1=M1+MON1
SET M2=M2+MON2
SET M3=M3+MON3
SET M4=M4+MON4
SET M5=M5+MON5
+12 SET MM1=MM1+MON1
SET MM2=MM2+MON2
SET MM3=MM3+MON3
SET MM4=MM4+MON4
SET MM5=MM5+MON5
+13 QUIT
End DoDot:1
+14 IF FHNXIEN'="ALL"!(EX=U)
GOTO END
QUIT
+15 IF ALLMON=0
WRITE !!?5,"NO PATIENTS WITH MONITORS IN GIVEN DATE RANGE"
DO END
QUIT
+16 ;
+17 WRITE !!,"** TOTAL COMMUNICATIONS OFFICE - Admissions.....: ",NAME
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+18 ;
+19 WRITE !!?16,"Totals for ALL ",$SELECT(FHSORT="C":"Clinicians.......: ",1:"Wards............: "),$JUSTIFY(ALLMON1,3)
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+20 ;I ZCO'="Y",ALLMON1=0 G PRINT
+21 IF ALLMON>0
WRITE !?16,"Monitor: Albumin < 2.8..........: ",$JUSTIFY(MM1,3)," ",$JUSTIFY(((MM1/ALLMON)*100),1,2),"%"
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+22 IF ALLMON>0
WRITE !?16,"Monitor: BMI < 18.5...............: ",$JUSTIFY(MM2,3)," ",$JUSTIFY(((MM2/ALLMON)*100),1,2),"%"
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+23 IF ALLMON>0
WRITE !?16,"Monitor: NPO+Clr Liq > 3 days...: ",$JUSTIFY(MM3,3)," ",$JUSTIFY(((MM3/ALLMON)*100),1,2),"%"
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+24 IF ALLMON>0
WRITE !?16,"Monitor: On Hyperals............: ",$JUSTIFY(MM4,3)," ",$JUSTIFY(((MM4/ALLMON)*100),1,2),"%"
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+25 IF ALLMON>0
WRITE !?16,"Monitor: On Tubefeeding.........: ",$JUSTIFY(MM5,3)," ",$JUSTIFY(((MM5/ALLMON)*100),1,2),"%"
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+26 ;
+27 ;
+28 SET (MM1,MM2,MM3,MM4,MM5,ALLMON1)=0
+29 GOTO PRINT
QUIT
+30 QUIT
+31 ;
THEND ;
+1 SET NAME="ALL COMMUNICATION OFFICES "
DO PG
IF EX=U
QUIT
+2 WRITE !!,"*** TOTAL PATIENTS WITH MONITORS ALL COMMUNICATION OFFICES....: ",CTCOMM
+3 ;
+4 WRITE !!?16,"Totals for ALL ",$SELECT(FHSORT="C":"Clinicians.......: ",1:"Wards............: "),$JUSTIFY(ALLMON,3)
+5 IF ALLMON>0
WRITE !?16,"Monitor: Albumin < 2.8..........: ",$JUSTIFY(M1,3)," ",$JUSTIFY(((M1/ALLMON)*100),1,2),"%"
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+6 IF ALLMON>0
WRITE !?16,"Monitor: BMI < 18.5...............: ",$JUSTIFY(M2,3)," ",$JUSTIFY(((M2/ALLMON)*100),1,2),"%"
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+7 IF ALLMON>0
WRITE !?16,"Monitor: NPO+Clr Liq > 3 days...: ",$JUSTIFY(M3,3)," ",$JUSTIFY(((M3/ALLMON)*100),1,2),"%"
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+8 IF ALLMON>0
WRITE !?16,"Monitor: On Hyperals............: ",$JUSTIFY(M4,3)," ",$JUSTIFY(((M4/ALLMON)*100),1,2),"%"
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+9 IF ALLMON>0
WRITE !?16,"Monitor: On Tubefeeding.........: ",$JUSTIFY(M5,3)," ",$JUSTIFY(((M5/ALLMON)*100),1,2),"%"
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+10 ;
+11 ;W !!!,"TOTAL ADMISSIONS....:",?23,FHTADM
+12 ;W !,"TOTAL MONITORS......:",?23,ALLMON
+13 ;I FHTADM>0 W !,"PERCENTAGE..........:",?23,$J(((ALLMON/FHTADM)*100),1,2),"%"
+14 DO LINE
+15 SET XX="*"
+16 QUIT
+17 ;I $Y>(IOSL-4)
+18 ;
D1END ;I IOST?1"C".E,EX'=U
WRITE !
KILL DIR
if EX'=U
QUIT
SET DIR(0)="E"
DO ^DIR
+1 DO END
QUIT
+2 QUIT
DISP ;
+1 SET (TOT,MON,MON1,MON2,MON3,MON4,MON5)=0
+2 FOR YY=0:0
SET YY=$ORDER(^TMP($JOB,"FHDATA",COMM,ZZ,YY))
if YY'>0
QUIT
Begin DoDot:1
DISP2 FOR HH=0:0
SET HH=$ORDER(^TMP($JOB,"FHDATA",COMM,ZZ,YY,HH))
if HH'>0!(EX=U)
QUIT
Begin DoDot:2
+1 IF $Y>(IOSL-4)
IF EX=U
QUIT
WRITE !
DO HDR
+2 SET CTCOMM=CTCOMM+1
+3 SET DFN=$PIECE(^TMP($JOB,"FHDATA",COMM,ZZ,YY,HH),U,5)
+4 SET Y=YY
XECUTE ^DD("DD")
WRITE !,Y
+5 WRITE ?13,$PIECE(^TMP($JOB,"FHDATA",COMM,ZZ,YY,HH),U,2)
+6 WRITE ?39,$PIECE(^TMP($JOB,"FHDATA",COMM,ZZ,YY,HH),U,3)
+7 WRITE ?47,$PIECE(^TMP($JOB,"FHDATA",COMM,ZZ,YY,HH),U,6)
+8 IF $PIECE(^TMP($JOB,"FHDATA",COMM,ZZ,YY,HH),U,7)="Yes"
Begin DoDot:3
+9 FOR NUM=0:0
SET NUM=$ORDER(FHMON(DFN,HH,NUM))
if NUM'>0!(EX=U)
QUIT
Begin DoDot:4
+10 IF NUM'=1
WRITE !
+11 SET MON=MON+1
SET MONTYP=$PIECE($PIECE(FHMON(DFN,HH,NUM),U,1),": ",2)
+12 SET PC=$SELECT(MONTYP["Albumin":1,MONTYP["BMI":2,MONTYP["NPO+Clr":3,MONTYP["Hyper":4,1:5)
+13 IF $GET(FHMNTT(COMM,ZZ))=""
SET FHMNTT(COMM,ZZ)=""
+14 SET $PIECE(FHMNTT(COMM,ZZ),U,PC)=$PIECE(FHMNTT(COMM,ZZ),U,PC)+1
+15 WRITE ?56,MONTYP
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+16 QUIT
End DoDot:4
+17 QUIT
End DoDot:3
+18 SET TOT=TOT+1
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 IF MON=0!(EX=U)
QUIT
+22 IF FHSORT="C"
WRITE !!,"* CLINICIAN: ",ZZ
+23 IF FHSORT="W"
WRITE !!,"* WARD: ",ZZ
+24 WRITE !?16,"Total Number of Monitors........: ",$JUSTIFY(MON,3)
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+25 SET PCE=$PIECE(FHMNTT(COMM,ZZ),U,1)
IF PCE>0
WRITE !?16,"Monitor: Albumin < 2.8..........: ",$JUSTIFY(PCE,3)," ",$JUSTIFY(((PCE/MON)*100),1,2),"%"
SET MON1=PCE
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+26 SET PCE=$PIECE(FHMNTT(COMM,ZZ),U,2)
IF PCE>0
WRITE !?16,"Monitor: BMI < 18.5...............: ",$JUSTIFY(PCE,3)," ",$JUSTIFY(((PCE/MON)*100),1,2),"%"
SET MON2=PCE
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+27 SET PCE=$PIECE(FHMNTT(COMM,ZZ),U,3)
IF PCE>0
WRITE !?16,"Monitor: NPO+Clr Liq > 3 days...: ",$JUSTIFY(PCE,3)," ",$JUSTIFY(((PCE/MON)*100),1,2),"%"
SET MON3=PCE
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+28 SET PCE=$PIECE(FHMNTT(COMM,ZZ),U,4)
IF PCE>0
WRITE !?16,"Monitor: On Hyperals............: ",$JUSTIFY(PCE,3)," ",$JUSTIFY(((PCE/MON)*100),1,2),"%"
SET MON4=PCE
IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+29 SET PCE=$PIECE(FHMNTT(COMM,ZZ),U,5)
IF PCE>0
WRITE !?16,"Monitor: On Tubefeeding.........: ",$JUSTIFY(PCE,3)," ",$JUSTIFY(((PCE/MON)*100),1,2),"%"
SET MON5=PCE
+30 WRITE !
+31 QUIT
+32 ;
MESSAGE ;
+1 WRITE !!?5,"NO PATIENTS WITH MONITORS IN GIVEN DATE RANGE"
+2 WRITE !?10,"FOR THIS ",$SELECT(FHSORT="C":"CLINICIAN",1:"WARD"),": ",FHNXIEN
+3 QUIT
END KILL FHMNTT,HH,M1,M2,M3,M4,M5,MON,MON1,MON2,MON3,MON4,MON5,MONTYP
+1 KILL NUM,PC,PCE,PG,PER,TOT,YY
+2 QUIT
+3 QUIT
+4 ;
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
+3 QUIT
HDR ;Header
+1 if $Y
WRITE @IOF
WRITE !,FHNDT,?60,"Page: "
SET PG=PG+1
WRITE PG,!
+2 WRITE !,?25,"Nutrition Monitor Statistic Report"
+3 WRITE !,NAME,!
+4 WRITE "Admission",?13,"Patient",?39,"SSN",?45,"Status",?56,"Monitor(s)"
LINE WRITE !
FOR Z=1:1:79
WRITE "="
+1 QUIT
MNAME ;
+1 IF ZCO'="Y"
SET CONUMX=CONUMX-1
if CONUMX<1
GOTO THEND
SET COXX=$PIECE(CO,"^",CONUMX)
SET NAME=$PIECE(CONAME,"^",CONUMX)
SET COMM=COXX
QUIT
+2 IF ZCO="Y"
SET COUNT=COUNT+1
if COUNT>ZOUT
GOTO THEND
SET NAME=$GET(^FH(119.73,COUNT,0))
SET NAME=$PIECE(NAME,"^")
SET COMM=COUNT
+3 IF $DATA(^FH(119.73,COUNT,"I"))!'$DATA(^FH(119.73,COUNT,0))
GOTO MNAME
+4 QUIT
QUIT ;
+1 WRITE !
+2 QUIT
