- FHMMBRPT ;Hines OIFO/JT,RTK,AAC - Multidiv Monitor Brief ;10/10/03 11:49
- ;;5.5;DIETETICS;;Jan 28, 2005
- ;
- COM ;get Communication Offices
- S (ZCO,CO,CONAME,CONAM,WARD,FHCOMM,ZZOUT,ZOUT,CONUMX)="",(COXX,ALLMON,ALLADM,ALLFHPER)=0
- ;S ZZOUT=$G(^FH(119.73,0)),CONUMX=$P(ZZOUT,"^",4),ZOUT=CONUMX
- 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 Communication Offices Y or N: ",ZCO:DTIME W ! S ZCO=$TR(ZCO,"y","Y")
- I ZCO'="Y" D N2 I (Y=-1)&(CO="") Q
- ;
- DATE ;sets date
- 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 PG=0,EX=""
- I Y<0 D END Q
- S FHEDT=Y
- D DEV Q
- ;D END
- ;
- EN ;get admission/monitor information
- I ZCO'="Y" S CONUMX=CONUMX-1 G:CONUMX=0 THEND S COXX=$P(CO,"^",CONUMX),NAME=$P(CONAME,"^",CONUMX)
- I ZCO="Y" S COXX=COXX+1 G:COXX>ZOUT THEND S NAME=$G(^FH(119.73,COXX,0)),NAME=$P(NAME,"^")
- I $D(^FH(119.73,COXX,"I"))!'$D(^FH(119.73,COXX,0)) G EN
- ;
- D NOW^%DTC S Y=X D DD^%DT S FHNDT=Y D PG
- S ADMTOT=0,MONTOT=0
- 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!(EX=U) S REC=$G(^DGPM(J,0)) S WARD=$P(REC,"^",6) Q:WARD="" D COFF Q:FHCOMM="" Q:$D(^FH(119.73,FHCOMM,"I")) Q:FHCOMM'=COXX D
- ..S DFN=$P(^DGPM(J,0),U,3) I $Y>(IOSL-4) D PG I EX=U Q
- ..S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
- ..S Y=$P(I,".") X ^DD("DD") W !,Y,?13,$E($P($G(^DPT(DFN,0)),U,1),1,23)
- ..W ?39,$E($P($G(^DPT(DFN,0)),U,9),6,9) S ADMTOT=ADMTOT+1
- ..I $D(^FHPT(FHDFN,"A",J,"MO","B")) W ?48,"Yes" S MONTOT=MONTOT+1
- ..S Y=$P($P($G(^FHPT(FHDFN,"A",J,0)),U,14),".",1) I Y X ^DD("DD") W ?56,Y
- ..Q
- .Q
- I EX=U D THEND Q
- W !!,"TOTAL ADMISSIONS: ",?22,ADMTOT S ALLADM=ALLADM+ADMTOT I $Y>(IOSL-4) D PG I EX=U Q
- W !,"TOTAL WITH MONITORS:",?22,MONTOT S ALLMON=ALLMON+MONTOT I $Y>(IOSL-4) D PG I EX=U Q
- W !,"Percentage of Admissions with Monitors: "
- I ADMTOT=0!(MONTOT=0) W "0.0%" D EN Q
- S FHPER=(MONTOT/ADMTOT)*100
- I $L($P(FHPER,".",2))>2 S FHPER=$P(FHPER,".",1)_"."_$E($P(FHPER,".",2),1,2)
- W FHPER,"%" I $Y>(IOSL-4) D PG I EX=U Q
- G EN
- I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR
- Q
- ;
- COFF ;get Communications Offices
- Q:'$D(^FH(119.6,"AW",WARD))
- S FHWARD=$O(^FH(119.6,"AW",WARD,""))
- S FHCOMM=$P($G(^FH(119.6,FHWARD,0)),"^",8)
- 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^FHMMBRPT",ZTSAVE("FHSDT")="",ZTSAVE("FHEDT")=""
- S ZTSAVE=("FHNDT")="",ZTSAVE=("FHPER")="",ZTSAVE("ZCO")=""
- S ZTSAVE("CO")="",ZTSAVE("ALLMON")="",ZTSAVE("PG")="",ZTSAVE("EX")=""
- S ZTSAVE("ZOUT")="",ZTSAVE("ALLADM")="",ZTSAVE("ALLFHPER")=""
- S ZTSAVE("COXX")="",ZTSAVE("CONUMX")="",ZTSAVE("FHCOMM")=""
- S ZTSAVE("CONAME")=""
- S ZTDESC="Dietetics Monitor Report" D ^%ZTLOAD
- D ^%ZISC K %ZIS,IOP
- ;D END Q
- ;
- END ;kill and quit
- K I,J,DFN,FHDFN,SSN,ADMTOT,MONTOT,FHPER,FHSDT,FHEDT,FHNDT,X,Y,PG
- Q
- ;
- THEND ;
- I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR
- S NAME="ALL COMMUNICATION OFFICES " D HDR
- W !!,"ALL TOTAL ADMISSIONS: ",?22,ALLADM
- W !,"TOTAL WITH MONITORS:",?22,ALLMON
- W !,"Percentage of Admissions with Monitors: "
- I ALLADM=0!(ALLMON=0) W "0.0%" D END Q
- S ALLFHPER=(ALLMON/ALLADM)*100
- I $L($P(ALLFHPER,".",2))>2 S ALLFHPER=$P(ALLFHPER,".",1)_"."_$E($P(ALLFHPER,".",2),1,2)
- W ALLFHPER,"%" I $Y>(IOSL-4) D PG I EX=U Q
- G END Q
- ;
- N2 ;find Communications 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
- ;
- PG ;
- I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
- D HDR Q
- HDR ;Header
- W:$Y @IOF W !,NAME,?30,"MONITOR BRIEF REPORT" W !,FHNDT,?60,"Page: " S PG=PG+1 W PG,!!
- W "Admission",?13,"Patient",?39,"SSN",?45,"Monitor?",?56,"Discharge"
- W ! F Z=1:1:79 W "="
- Q
- FHMMBRPT ;Hines OIFO/JT,RTK,AAC - Multidiv Monitor Brief ;10/10/03 11:49
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 ;
- COM ;get Communication Offices
- +1 SET (ZCO,CO,CONAME,CONAM,WARD,FHCOMM,ZZOUT,ZOUT,CONUMX)=""
- SET (COXX,ALLMON,ALLADM,ALLFHPER)=0
- +2 ;S ZZOUT=$G(^FH(119.73,0)),CONUMX=$P(ZZOUT,"^",4),ZOUT=CONUMX
- +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 Communication Offices Y or N: ",ZCO:DTIME
- WRITE !
- SET ZCO=$TRANSLATE(ZCO,"y","Y")
- +5 IF ZCO'="Y"
- DO N2
- IF (Y=-1)&(CO="")
- QUIT
- +6 ;
- DATE ;sets date
- +1 WRITE !
- SET %DT="AEPT"
- SET %DT("A")="Enter beginning date: "
- DO ^%DT
- IF Y<0
- QUIT
- +2 SET FHSDT=Y
- SET %DT(0)=FHSDT
- SET %DT("A")="Enter ending date: "
- DO ^%DT
- KILL %DT(0)
- +3 SET PG=0
- SET EX=""
- +4 IF Y<0
- DO END
- QUIT
- +5 SET FHEDT=Y
- +6 DO DEV
- QUIT
- +7 ;D END
- +8 ;
- EN ;get admission/monitor information
- +1 IF ZCO'="Y"
- SET CONUMX=CONUMX-1
- IF CONUMX=0
- GOTO THEND
- SET COXX=$PIECE(CO,"^",CONUMX)
- SET NAME=$PIECE(CONAME,"^",CONUMX)
- +2 IF ZCO="Y"
- SET COXX=COXX+1
- IF COXX>ZOUT
- GOTO THEND
- SET NAME=$GET(^FH(119.73,COXX,0))
- SET NAME=$PIECE(NAME,"^")
- +3 IF $DATA(^FH(119.73,COXX,"I"))!'$DATA(^FH(119.73,COXX,0))
- GOTO EN
- +4 ;
- +5 DO NOW^%DTC
- SET Y=X
- DO DD^%DT
- SET FHNDT=Y
- DO PG
- +6 SET ADMTOT=0
- SET MONTOT=0
- +7 SET I=FHSDT
- FOR
- SET I=$ORDER(^DGPM("ATT1",I))
- IF 'I!(I>FHEDT)
- QUIT
- Begin DoDot:1
- +8 SET J=0
- FOR
- SET J=$ORDER(^DGPM("ATT1",I,J))
- IF 'J!(EX=U)
- QUIT
- SET REC=$GET(^DGPM(J,0))
- SET WARD=$PIECE(REC,"^",6)
- IF WARD=""
- QUIT
- DO COFF
- IF FHCOMM=""
- QUIT
- IF $DATA(^FH(119.73,FHCOMM,"I"))
- QUIT
- IF FHCOMM'=COXX
- QUIT
- Begin DoDot:2
- +9 SET DFN=$PIECE(^DGPM(J,0),U,3)
- IF $Y>(IOSL-4)
- DO PG
- IF EX=U
- QUIT
- +10 SET FHZ115="P"_DFN
- DO CHECK^FHOMDPA
- IF FHDFN=""
- QUIT
- +11 SET Y=$PIECE(I,".")
- XECUTE ^DD("DD")
- WRITE !,Y,?13,$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,1),1,23)
- +12 WRITE ?39,$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,9),6,9)
- SET ADMTOT=ADMTOT+1
- +13 IF $DATA(^FHPT(FHDFN,"A",J,"MO","B"))
- WRITE ?48,"Yes"
- SET MONTOT=MONTOT+1
- +14 SET Y=$PIECE($PIECE($GET(^FHPT(FHDFN,"A",J,0)),U,14),".",1)
- IF Y
- XECUTE ^DD("DD")
- WRITE ?56,Y
- +15 QUIT
- End DoDot:2
- +16 QUIT
- End DoDot:1
- +17 IF EX=U
- DO THEND
- QUIT
- +18 WRITE !!,"TOTAL ADMISSIONS: ",?22,ADMTOT
- SET ALLADM=ALLADM+ADMTOT
- IF $Y>(IOSL-4)
- DO PG
- IF EX=U
- QUIT
- +19 WRITE !,"TOTAL WITH MONITORS:",?22,MONTOT
- SET ALLMON=ALLMON+MONTOT
- IF $Y>(IOSL-4)
- DO PG
- IF EX=U
- QUIT
- +20 WRITE !,"Percentage of Admissions with Monitors: "
- +21 IF ADMTOT=0!(MONTOT=0)
- WRITE "0.0%"
- DO EN
- QUIT
- +22 SET FHPER=(MONTOT/ADMTOT)*100
- +23 IF $LENGTH($PIECE(FHPER,".",2))>2
- SET FHPER=$PIECE(FHPER,".",1)_"."_$EXTRACT($PIECE(FHPER,".",2),1,2)
- +24 WRITE FHPER,"%"
- IF $Y>(IOSL-4)
- DO PG
- IF EX=U
- QUIT
- +25 GOTO EN
- +26 IF IOST?1"C".E
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- +27 QUIT
- +28 ;
- COFF ;get Communications Offices
- +1 IF '$DATA(^FH(119.6,"AW",WARD))
- QUIT
- +2 SET FHWARD=$ORDER(^FH(119.6,"AW",WARD,""))
- +3 SET FHCOMM=$PIECE($GET(^FH(119.6,FHWARD,0)),"^",8)
- +4 QUIT
- +5 ;
- 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^FHMMBRPT"
- SET ZTSAVE("FHSDT")=""
- SET ZTSAVE("FHEDT")=""
- +4 SET ZTSAVE=("FHNDT")=""
- SET ZTSAVE=("FHPER")=""
- SET ZTSAVE("ZCO")=""
- +5 SET ZTSAVE("CO")=""
- SET ZTSAVE("ALLMON")=""
- SET ZTSAVE("PG")=""
- SET ZTSAVE("EX")=""
- +6 SET ZTSAVE("ZOUT")=""
- SET ZTSAVE("ALLADM")=""
- SET ZTSAVE("ALLFHPER")=""
- +7 SET ZTSAVE("COXX")=""
- SET ZTSAVE("CONUMX")=""
- SET ZTSAVE("FHCOMM")=""
- +8 SET ZTSAVE("CONAME")=""
- +9 SET ZTDESC="Dietetics Monitor Report"
- DO ^%ZTLOAD
- +10 DO ^%ZISC
- KILL %ZIS,IOP
- +11 ;D END Q
- +12 ;
- END ;kill and quit
- +1 KILL I,J,DFN,FHDFN,SSN,ADMTOT,MONTOT,FHPER,FHSDT,FHEDT,FHNDT,X,Y,PG
- +2 QUIT
- +3 ;
- THEND ;
- +1 IF IOST?1"C".E
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- +2 SET NAME="ALL COMMUNICATION OFFICES "
- DO HDR
- +3 WRITE !!,"ALL TOTAL ADMISSIONS: ",?22,ALLADM
- +4 WRITE !,"TOTAL WITH MONITORS:",?22,ALLMON
- +5 WRITE !,"Percentage of Admissions with Monitors: "
- +6 IF ALLADM=0!(ALLMON=0)
- WRITE "0.0%"
- DO END
- QUIT
- +7 SET ALLFHPER=(ALLMON/ALLADM)*100
- +8 IF $LENGTH($PIECE(ALLFHPER,".",2))>2
- SET ALLFHPER=$PIECE(ALLFHPER,".",1)_"."_$EXTRACT($PIECE(ALLFHPER,".",2),1,2)
- +9 WRITE ALLFHPER,"%"
- IF $Y>(IOSL-4)
- DO PG
- IF EX=U
- QUIT
- +10 GOTO END
- QUIT
- +11 ;
- N2 ;find Communications 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 ;
- 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
- HDR ;Header
- +1 IF $Y
- WRITE @IOF
- WRITE !,NAME,?30,"MONITOR BRIEF REPORT"
- WRITE !,FHNDT,?60,"Page: "
- SET PG=PG+1
- WRITE PG,!!
- +2 WRITE "Admission",?13,"Patient",?39,"SSN",?45,"Monitor?",?56,"Discharge"
- +3 WRITE !
- FOR Z=1:1:79
- WRITE "="
- +4 QUIT
