- FHMMNREP ;Hines OIFO/RTK,AAC - Multidiv Monitor Report ;10/10/03 11:49
- ;;5.5;DIETETICS;;Jan 28, 2005
- ;
- COM ;Get Communication Offices
- S (ZCO,CO,COXX,CONAME,CONAM,WARD,FHCOMM)="",(ZCOMM,CONUMX,ALLCOMM)=0
- ;S ZZOUT=$G(^FH(119.73,0)),ZOUT=$P(ZZOUT,"^",4)
- S ZZCOUNT=0 F ZZCOUNT=0:0 S ZZCOUNT=$O(^FH(119.73,ZZCOUNT)) Q:ZZCOUNT'>0 S ZOUT=ZZCOUNT
- R !!,"Print report for all Communications Offices Y or N: ",ZCO:DTIME W ! S ZCO=$TR(ZCO,"y","Y")
- Q:ZCO="^"
- I ZCO'="Y" D N2 I (Y=-1)&(CO="") Q
- ;
- DATE ;sets date
- 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 ;
- ;^TMP($J,"FHDATA") SUBSCRIPTS (CLINIC OR WARD NAME,DGPM DATE,DGPM ENTRY)
- ;^TMP($J,"FHDATA") PIECES="PatName^SSN^Monitors?^DischargeDt^DFN^Status"
- ;
- K ^TMP($J,"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 ZCOMM=ZCOMM+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 FHWARD=$P($G(^DGPM(J,0)),U,6)
- ..Q:'$D(^FH(119.6,"AW",FHWARD))
- ..S WRD=$O(^FH(119.6,"AW",FHWARD,""))
- ..S FHCOMM=$P($G(^FH(119.6,WRD,0)),"^",8),CLN=$P($G(^FH(119.6,WRD,0)),"^",2)
- ..Q:FHCOMM="" Q:$D(^FH(119.73,FHCOMM,"I"))
- ..S FHTADM=FHTADM+1
- ..S ALLCOMM=ALLCOMM+1
- ..;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(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,1)=FHCOMM
- ..S $P(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,2)=$E($P($G(^DPT(DFN,0)),U,1),1,23)
- ..S $P(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,5)=DFN
- ..S $P(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,3)=$E($P($G(^DPT(DFN,0)),U,9),6,9)
- ..I $D(^FHPT(FHDFN,"A",J,"MO","B")) S $P(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,7)="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(^TMP($J,"FHDATA",FHCOMM,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(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,6)=$P($G(^FH(115.4,STAT,0)),U,1)
- ..Q
- .Q
- D ^FHMMNPRT
- Q
- ;
- THEND ;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^FHMMNREP",ZTSAVE("FHSDT")="",ZTSAVE("FHEDT")="",ZTSAVE("ZCOMM")=""
- S ZTSAVE("FHNDT")="",ZTSAVE("FHPER")="",ZTSAVE("FHSORT")=""
- S ZTSAVE("FHNXIEN")="",ZTSAVE("FHTADM")="",ZTSAVE("FHTMON")=""
- S ZTSAVE("ALLCOMM")="",ZTSAVE("ZCO")="",ZTSAVE("COXX")="",ZTSAVE("ZOUT")=""
- S ZTSAVE("CONUMX")="",ZTSAVE("CO")="",ZTSAVE("CONAME")=""
- S ZTDESC="Dietetics Monitor Report" D ^%ZTLOAD
- D ^%ZISC K %ZIS,IOP
- D END Q
- ;
- N2 ;Find Communication Office
- S DIC=119.73,DIC(0)="AEQ",DIC("A")="Select Communication Offices: "
- D ^DIC I Y=-1&(CO="") Q
- I Y=-1 Q
- S CON=$P(Y,"^",1),CO=CON_"^"_CO,CONAM=$P(Y,"^",2),CONAME=CONAM_"^"_CONAME S CONUMX=$L(CO,"^") G N2
- I Y=-1 K DIC Q
- 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
- FHMMNREP ;Hines OIFO/RTK,AAC - Multidiv Monitor Report ;10/10/03 11:49
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 ;
- COM ;Get Communication Offices
- +1 SET (ZCO,CO,COXX,CONAME,CONAM,WARD,FHCOMM)=""
- SET (ZCOMM,CONUMX,ALLCOMM)=0
- +2 ;S ZZOUT=$G(^FH(119.73,0)),ZOUT=$P(ZZOUT,"^",4)
- +3 SET ZZCOUNT=0
- FOR ZZCOUNT=0:0
- SET ZZCOUNT=$ORDER(^FH(119.73,ZZCOUNT))
- IF ZZCOUNT'>0
- QUIT
- SET ZOUT=ZZCOUNT
- +4 READ !!,"Print report for all Communications Offices Y or N: ",ZCO:DTIME
- WRITE !
- SET ZCO=$TRANSLATE(ZCO,"y","Y")
- +5 IF ZCO="^"
- QUIT
- +6 IF ZCO'="Y"
- DO N2
- IF (Y=-1)&(CO="")
- QUIT
- +7 ;
- DATE ;sets date
- +1 SET (FHTADM,FHTMON)=0
- +2 WRITE !
- SET %DT="AEPT"
- SET %DT("A")="Enter beginning date: "
- DO ^%DT
- IF Y<0
- QUIT
- +3 SET FHSDT=Y
- SET %DT(0)=FHSDT
- SET %DT("A")="Enter ending date: "
- DO ^%DT
- KILL %DT(0)
- +4 SET FHEDT=Y
- IF Y<0
- DO END
- QUIT
- +5 DO SORTCR
- SET FHSORT=Y
- IF Y="^"
- DO END
- QUIT
- +6 IF FHSORT="C"
- DO FHCL
- IF '$DATA(FHCLIEN)
- QUIT
- SET FHNXIEN=CLNAM
- +7 IF FHSORT="W"
- DO FHWA
- IF '$DATA(FHWRIEN)
- QUIT
- SET FHNXIEN=WRDNAM
- +8 DO DEV
- DO END
- QUIT
- +9 ;
- 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 ;^TMP($J,"FHDATA") SUBSCRIPTS (CLINIC OR WARD NAME,DGPM DATE,DGPM ENTRY)
- +2 ;^TMP($J,"FHDATA") PIECES="PatName^SSN^Monitors?^DischargeDt^DFN^Status"
- +3 ;
- +4 KILL ^TMP($JOB,"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 ZCOMM=ZCOMM+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 FHWARD=$PIECE($GET(^DGPM(J,0)),U,6)
- +13 IF '$DATA(^FH(119.6,"AW",FHWARD))
- QUIT
- +14 SET WRD=$ORDER(^FH(119.6,"AW",FHWARD,""))
- +15 SET FHCOMM=$PIECE($GET(^FH(119.6,WRD,0)),"^",8)
- SET CLN=$PIECE($GET(^FH(119.6,WRD,0)),"^",2)
- +16 IF FHCOMM=""
- QUIT
- IF $DATA(^FH(119.73,FHCOMM,"I"))
- QUIT
- +17 SET FHTADM=FHTADM+1
- +18 SET ALLCOMM=ALLCOMM+1
- +19 ;S CLN=$P($G(^DGPM(J,0)),U,19),WRD=$P($G(^DGPM(J,0)),U,6)
- +20 SET INDX=$SELECT(FHSORT="C":CLN,1:WRD)
- IF INDX=""
- QUIT
- +21 SET INDX=$SELECT(FHSORT="C":$PIECE($GET(^VA(200,CLN,0)),U,1),1:$PIECE($GET(^FH(119.6,WRD,0)),U,1))
- +22 SET $PIECE(^TMP($JOB,"FHDATA",FHCOMM,INDX,II,J),U,1)=FHCOMM
- +23 SET $PIECE(^TMP($JOB,"FHDATA",FHCOMM,INDX,II,J),U,2)=$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,1),1,23)
- +24 SET $PIECE(^TMP($JOB,"FHDATA",FHCOMM,INDX,II,J),U,5)=DFN
- +25 SET $PIECE(^TMP($JOB,"FHDATA",FHCOMM,INDX,II,J),U,3)=$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,9),6,9)
- +26 IF $DATA(^FHPT(FHDFN,"A",J,"MO","B"))
- SET $PIECE(^TMP($JOB,"FHDATA",FHCOMM,INDX,II,J),U,7)="Yes"
- SET FHTMON=FHTMON+1
- SET MCNT=0
- Begin DoDot:3
- +27 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
- +28 SET Y=$PIECE($PIECE($GET(^FHPT(FHDFN,"A",J,0)),U,14),".",1)
- IF Y
- XECUTE ^DD("DD")
- SET $PIECE(^TMP($JOB,"FHDATA",FHCOMM,INDX,II,J),U,4)=Y
- +29 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(^TMP($JOB,"FHDATA",FHCOMM,INDX,II,J),U,6)=$PIECE($GET(^FH(115.4,STAT,0)),U,1)
- +30 QUIT
- End DoDot:2
- +31 QUIT
- End DoDot:1
- +32 DO ^FHMMNPRT
- +33 QUIT
- +34 ;
- THEND ;Q
- +1 ;
- 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^FHMMNREP"
- SET ZTSAVE("FHSDT")=""
- SET ZTSAVE("FHEDT")=""
- SET ZTSAVE("ZCOMM")=""
- +4 SET ZTSAVE("FHNDT")=""
- SET ZTSAVE("FHPER")=""
- SET ZTSAVE("FHSORT")=""
- +5 SET ZTSAVE("FHNXIEN")=""
- SET ZTSAVE("FHTADM")=""
- SET ZTSAVE("FHTMON")=""
- +6 SET ZTSAVE("ALLCOMM")=""
- SET ZTSAVE("ZCO")=""
- SET ZTSAVE("COXX")=""
- SET ZTSAVE("ZOUT")=""
- +7 SET ZTSAVE("CONUMX")=""
- SET ZTSAVE("CO")=""
- SET ZTSAVE("CONAME")=""
- +8 SET ZTDESC="Dietetics Monitor Report"
- DO ^%ZTLOAD
- +9 DO ^%ZISC
- KILL %ZIS,IOP
- +10 DO END
- QUIT
- +11 ;
- N2 ;Find Communication Office
- +1 SET DIC=119.73
- SET DIC(0)="AEQ"
- SET DIC("A")="Select Communication Offices: "
- +2 DO ^DIC
- IF Y=-1&(CO="")
- QUIT
- +3 IF Y=-1
- QUIT
- +4 SET CON=$PIECE(Y,"^",1)
- SET CO=CON_"^"_CO
- SET CONAM=$PIECE(Y,"^",2)
- SET CONAME=CONAM_"^"_CONAME
- SET CONUMX=$LENGTH(CO,"^")
- GOTO N2
- +5 IF Y=-1
- KILL DIC
- QUIT
- +6 QUIT
- +7 ;
- 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
