FHMNREP ;Hines OIFO/RTK - Dietetics Monitor Report ;10/18/01 11:49
;;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 ^FHMMNREP Q
S (FHTADM,FHTMON)=0
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)
S FHEDT=Y I Y<0 D END Q
D SORTCR S FHSORT=Y I Y="^" D END Q
I FHSORT="C" D FHCL Q:'$D(FHCLIEN) S FHNXIEN=CLNAM
I FHSORT="W" D FHWA Q:'$D(FHWRIEN) S FHNXIEN=WRDNAM
D DEV,END Q
;
FHCL ;
K DIR S DIR(0)="Y",DIR("A")="Select ALL Clinicians",DIR("B")="Y" D ^DIR
I Y=1 S (FHCLIEN,CLNAM)="ALL"
I Y=0 K DIC S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")="Select CLINICIAN: " D ^DIC S FHCLIEN=$P(Y,U,1),CLNAM=$P($G(^VA(200,FHCLIEN,0)),U,1)
I (Y=-1)!($D(DUOUT))!($D(DTOUT)) D END Q
Q
FHWA ;
K DIR S DIR(0)="Y",DIR("A")="Select ALL Wards",DIR("B")="Y" D ^DIR
I Y=1 S (FHWRIEN,WRDNAM)="ALL"
I Y=0 K DIC S DIC="^FH(119.6,",DIC(0)="AEQM" D ^DIC S FHWRIEN=$P(Y,U,1),WRDNAM=$P($G(^FH(119.6,FHWRIEN,0)),U,1)
I (Y=-1)!($D(DUOUT))!($D(DTOUT)) D END Q
Q
EN ;
;FHDATA SUBSCRIPTS(CLINIC OR WARD NAME,DGPM DATE,DGPM ENTRY)
;FHDATA ARRAY="PatName^SSN^Monitors?^DischargeDt^DFN^Status"
;
K FHDATA,FHMON
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 D
..S FHTADM=FHTADM+1
..S DFN=$P($G(^DGPM(J,0)),U,3)
..S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
..I '$D(^FHPT(FHDFN,"A",J,"MO","B")) Q
..S II=$P(I,".")
..S WRD=$P($G(^FHPT(FHDFN,"A",J,0)),U,8),CLN=""
..I WRD'="" S CLN=$P($G(^FH(119.6,WRD,0)),"^",2)
..;S CLN=$P($G(^DGPM(J,0)),U,19),WRD=$P($G(^DGPM(J,0)),U,6)
..S INDX=$S(FHSORT="C":CLN,1:WRD) I INDX="" Q
..S INDX=$S(FHSORT="C":$P($G(^VA(200,CLN,0)),U,1),1:$P($G(^FH(119.6,WRD,0)),U,1))
..S $P(FHDATA(INDX,II,J),U,1)=$E($P(^DPT(DFN,0),U,1),1,23)
..S $P(FHDATA(INDX,II,J),U,5)=DFN
..S $P(FHDATA(INDX,II,J),U,2)=$E($P(^DPT(DFN,0),U,9),6,9)
..I $D(^FHPT(FHDFN,"A",J,"MO","B")) S $P(FHDATA(INDX,II,J),U,3)="Yes",FHTMON=FHTMON+1,MCNT=0 D
...F FHMN=0:0 S FHMN=$O(^FHPT(FHDFN,"A",J,"MO",FHMN)) Q:FHMN'>0 S MCNT=MCNT+1,FHMON(DFN,J,MCNT)=$P($G(^FHPT(FHDFN,"A",J,"MO",FHMN,0)),"^",1)
..S Y=$P($P($G(^FHPT(FHDFN,"A",J,0)),U,14),".",1) I Y X ^DD("DD") S $P(FHDATA(INDX,II,J),U,4)=Y
..I $D(^FHPT(FHDFN,"S",0)) S NS=$O(^FHPT(FHDFN,"S",0)),STAT=$P($G(^FHPT(FHDFN,"S",NS,0)),U,2) S $P(FHDATA(INDX,II,J),U,6)=$P($G(^FH(115.4,STAT,0)),U,1)
..Q
.Q
D PRINT^FHMNPRT
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^FHMNREP",ZTSAVE("FHSDT")="",ZTSAVE("FHEDT")=""
S ZTSAVE("FHNDT")="",ZTSAVE("FHPER")="",ZTSAVE("FHSORT")=""
S ZTSAVE("FHNXIEN")="",ZTSAVE("FHTADM")="",ZTSAVE("FHTMON")=""
S ZTDESC="Dietetics Monitor Report" D ^%ZTLOAD
D ^%ZISC K %ZIS,IOP
D END Q
SORTCR ;
K DIR S DIR(0)="SB^C:CLINICIAN;W:WARD",DIR("A")="Sort by Clinician/Ward"
D ^DIR
Q
END ;kill and quit
K CLN,CLNAM,FHDFN,DFN,I,II,INDX,J,SSN,MCNT
K FHCLIEN,FHEDT,FHMN,FHNDT,FHNXIEN,FHTADM,FHTMON
K FHPER,FHSDT,FHSORT,FHWRIEN,WRD,WRDNAM,X,Y,Z
Q
FHMNREP ;Hines OIFO/RTK - Dietetics Monitor Report ;10/18/01 11:49
+1 ;;5.5;DIETETICS;;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 ^FHMMNREP
QUIT
+3 SET (FHTADM,FHTMON)=0
+4 WRITE !
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
KILL %DT(0)
+6 SET FHEDT=Y
IF Y<0
DO END
QUIT
+7 DO SORTCR
SET FHSORT=Y
IF Y="^"
DO END
QUIT
+8 IF FHSORT="C"
DO FHCL
IF '$DATA(FHCLIEN)
QUIT
SET FHNXIEN=CLNAM
+9 IF FHSORT="W"
DO FHWA
IF '$DATA(FHWRIEN)
QUIT
SET FHNXIEN=WRDNAM
+10 DO DEV
DO END
QUIT
+11 ;
FHCL ;
+1 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Select ALL Clinicians"
SET DIR("B")="Y"
DO ^DIR
+2 IF Y=1
SET (FHCLIEN,CLNAM)="ALL"
+3 IF Y=0
KILL DIC
SET DIC="^VA(200,"
SET DIC(0)="AEQM"
SET DIC("A")="Select CLINICIAN: "
DO ^DIC
SET FHCLIEN=$PIECE(Y,U,1)
SET CLNAM=$PIECE($GET(^VA(200,FHCLIEN,0)),U,1)
+4 IF (Y=-1)!($DATA(DUOUT))!($DATA(DTOUT))
DO END
QUIT
+5 QUIT
FHWA ;
+1 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Select ALL Wards"
SET DIR("B")="Y"
DO ^DIR
+2 IF Y=1
SET (FHWRIEN,WRDNAM)="ALL"
+3 IF Y=0
KILL DIC
SET DIC="^FH(119.6,"
SET DIC(0)="AEQM"
DO ^DIC
SET FHWRIEN=$PIECE(Y,U,1)
SET WRDNAM=$PIECE($GET(^FH(119.6,FHWRIEN,0)),U,1)
+4 IF (Y=-1)!($DATA(DUOUT))!($DATA(DTOUT))
DO END
QUIT
+5 QUIT
EN ;
+1 ;FHDATA SUBSCRIPTS(CLINIC OR WARD NAME,DGPM DATE,DGPM ENTRY)
+2 ;FHDATA ARRAY="PatName^SSN^Monitors?^DischargeDt^DFN^Status"
+3 ;
+4 KILL FHDATA,FHMON
+5 SET I=FHSDT
FOR
SET I=$ORDER(^DGPM("ATT1",I))
IF 'I!(I>FHEDT)
QUIT
Begin DoDot:1
+6 SET J=0
FOR
SET J=$ORDER(^DGPM("ATT1",I,J))
IF 'J
QUIT
Begin DoDot:2
+7 SET FHTADM=FHTADM+1
+8 SET DFN=$PIECE($GET(^DGPM(J,0)),U,3)
+9 SET FHZ115="P"_DFN
DO CHECK^FHOMDPA
IF FHDFN=""
QUIT
+10 IF '$DATA(^FHPT(FHDFN,"A",J,"MO","B"))
QUIT
+11 SET II=$PIECE(I,".")
+12 SET WRD=$PIECE($GET(^FHPT(FHDFN,"A",J,0)),U,8)
SET CLN=""
+13 IF WRD'=""
SET CLN=$PIECE($GET(^FH(119.6,WRD,0)),"^",2)
+14 ;S CLN=$P($G(^DGPM(J,0)),U,19),WRD=$P($G(^DGPM(J,0)),U,6)
+15 SET INDX=$SELECT(FHSORT="C":CLN,1:WRD)
IF INDX=""
QUIT
+16 SET INDX=$SELECT(FHSORT="C":$PIECE($GET(^VA(200,CLN,0)),U,1),1:$PIECE($GET(^FH(119.6,WRD,0)),U,1))
+17 SET $PIECE(FHDATA(INDX,II,J),U,1)=$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,23)
+18 SET $PIECE(FHDATA(INDX,II,J),U,5)=DFN
+19 SET $PIECE(FHDATA(INDX,II,J),U,2)=$EXTRACT($PIECE(^DPT(DFN,0),U,9),6,9)
+20 IF $DATA(^FHPT(FHDFN,"A",J,"MO","B"))
SET $PIECE(FHDATA(INDX,II,J),U,3)="Yes"
SET FHTMON=FHTMON+1
SET MCNT=0
Begin DoDot:3
+21 FOR FHMN=0:0
SET FHMN=$ORDER(^FHPT(FHDFN,"A",J,"MO",FHMN))
IF FHMN'>0
QUIT
SET MCNT=MCNT+1
SET FHMON(DFN,J,MCNT)=$PIECE($GET(^FHPT(FHDFN,"A",J,"MO",FHMN,0)),"^",1)
End DoDot:3
+22 SET Y=$PIECE($PIECE($GET(^FHPT(FHDFN,"A",J,0)),U,14),".",1)
IF Y
XECUTE ^DD("DD")
SET $PIECE(FHDATA(INDX,II,J),U,4)=Y
+23 IF $DATA(^FHPT(FHDFN,"S",0))
SET NS=$ORDER(^FHPT(FHDFN,"S",0))
SET STAT=$PIECE($GET(^FHPT(FHDFN,"S",NS,0)),U,2)
SET $PIECE(FHDATA(INDX,II,J),U,6)=$PIECE($GET(^FH(115.4,STAT,0)),U,1)
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 DO PRINT^FHMNPRT
+27 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^FHMNREP"
SET ZTSAVE("FHSDT")=""
SET ZTSAVE("FHEDT")=""
+4 SET ZTSAVE("FHNDT")=""
SET ZTSAVE("FHPER")=""
SET ZTSAVE("FHSORT")=""
+5 SET ZTSAVE("FHNXIEN")=""
SET ZTSAVE("FHTADM")=""
SET ZTSAVE("FHTMON")=""
+6 SET ZTDESC="Dietetics Monitor Report"
DO ^%ZTLOAD
+7 DO ^%ZISC
KILL %ZIS,IOP
+8 DO END
QUIT
SORTCR ;
+1 KILL DIR
SET DIR(0)="SB^C:CLINICIAN;W:WARD"
SET DIR("A")="Sort by Clinician/Ward"
+2 DO ^DIR
+3 QUIT
END ;kill and quit
+1 KILL CLN,CLNAM,FHDFN,DFN,I,II,INDX,J,SSN,MCNT
+2 KILL FHCLIEN,FHEDT,FHMN,FHNDT,FHNXIEN,FHTADM,FHTMON
+3 KILL FHPER,FHSDT,FHSORT,FHWRIEN,WRD,WRDNAM,X,Y,Z
+4 QUIT
