- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHMNREP 3180 printed Mar 13, 2025@20:52:41 Page 2
- 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
