1 | FHMMBRPT ;Hines OIFO/JT,RTK,AAC - Multidiv Monitor Brief ;10/10/03 11:49
|
---|
2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
---|
3 | ;
|
---|
4 | COM ;get Communication Offices
|
---|
5 | S (ZCO,CO,CONAME,CONAM,WARD,FHCOMM,ZZOUT,ZOUT,CONUMX)="",(COXX,ALLMON,ALLADM,ALLFHPER)=0
|
---|
6 | ;S ZZOUT=$G(^FH(119.73,0)),CONUMX=$P(ZZOUT,"^",4),ZOUT=CONUMX
|
---|
7 | S ZZCOUNT=0 F ZZCOUNT=0:0 S ZZCOUNT=$O(^FH(119.73,ZZCOUNT)) Q:ZZCOUNT'>0 S ZOUT=ZZCOUNT
|
---|
8 | R !!,"Print report for all Communication Offices Y or N: ",ZCO:DTIME W ! S ZCO=$TR(ZCO,"y","Y")
|
---|
9 | I ZCO'="Y" D N2 I (Y=-1)&(CO="") Q
|
---|
10 | ;
|
---|
11 | DATE ;sets date
|
---|
12 | W ! S %DT="AEPT",%DT("A")="Enter beginning date: " D ^%DT Q:Y<0
|
---|
13 | S FHSDT=Y,%DT(0)=FHSDT,%DT("A")="Enter ending date: " D ^%DT K %DT(0)
|
---|
14 | S PG=0,EX=""
|
---|
15 | I Y<0 D END Q
|
---|
16 | S FHEDT=Y
|
---|
17 | D DEV Q
|
---|
18 | ;D END
|
---|
19 | ;
|
---|
20 | EN ;get admission/monitor information
|
---|
21 | I ZCO'="Y" S CONUMX=CONUMX-1 G:CONUMX=0 THEND S COXX=$P(CO,"^",CONUMX),NAME=$P(CONAME,"^",CONUMX)
|
---|
22 | I ZCO="Y" S COXX=COXX+1 G:COXX>ZOUT THEND S NAME=$G(^FH(119.73,COXX,0)),NAME=$P(NAME,"^")
|
---|
23 | I $D(^FH(119.73,COXX,"I"))!'$D(^FH(119.73,COXX,0)) G EN
|
---|
24 | ;
|
---|
25 | D NOW^%DTC S Y=X D DD^%DT S FHNDT=Y D PG
|
---|
26 | S ADMTOT=0,MONTOT=0
|
---|
27 | S I=FHSDT F S I=$O(^DGPM("ATT1",I)) Q:'I!(I>FHEDT) D
|
---|
28 | .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
|
---|
29 | ..S DFN=$P(^DGPM(J,0),U,3) I $Y>(IOSL-4) D PG I EX=U Q
|
---|
30 | ..S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
|
---|
31 | ..S Y=$P(I,".") X ^DD("DD") W !,Y,?13,$E($P($G(^DPT(DFN,0)),U,1),1,23)
|
---|
32 | ..W ?39,$E($P($G(^DPT(DFN,0)),U,9),6,9) S ADMTOT=ADMTOT+1
|
---|
33 | ..I $D(^FHPT(FHDFN,"A",J,"MO","B")) W ?48,"Yes" S MONTOT=MONTOT+1
|
---|
34 | ..S Y=$P($P($G(^FHPT(FHDFN,"A",J,0)),U,14),".",1) I Y X ^DD("DD") W ?56,Y
|
---|
35 | ..Q
|
---|
36 | .Q
|
---|
37 | I EX=U D THEND Q
|
---|
38 | W !!,"TOTAL ADMISSIONS: ",?22,ADMTOT S ALLADM=ALLADM+ADMTOT I $Y>(IOSL-4) D PG I EX=U Q
|
---|
39 | W !,"TOTAL WITH MONITORS:",?22,MONTOT S ALLMON=ALLMON+MONTOT I $Y>(IOSL-4) D PG I EX=U Q
|
---|
40 | W !,"Percentage of Admissions with Monitors: "
|
---|
41 | I ADMTOT=0!(MONTOT=0) W "0.0%" D EN Q
|
---|
42 | S FHPER=(MONTOT/ADMTOT)*100
|
---|
43 | I $L($P(FHPER,".",2))>2 S FHPER=$P(FHPER,".",1)_"."_$E($P(FHPER,".",2),1,2)
|
---|
44 | W FHPER,"%" I $Y>(IOSL-4) D PG I EX=U Q
|
---|
45 | G EN
|
---|
46 | I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR
|
---|
47 | Q
|
---|
48 | ;
|
---|
49 | COFF ;get Communications Offices
|
---|
50 | Q:'$D(^FH(119.6,"AW",WARD))
|
---|
51 | S FHWARD=$O(^FH(119.6,"AW",WARD,""))
|
---|
52 | S FHCOMM=$P($G(^FH(119.6,FHWARD,0)),"^",8)
|
---|
53 | Q
|
---|
54 | ;
|
---|
55 | DEV ;get device and set up queue
|
---|
56 | W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
|
---|
57 | I '$D(IO("Q")) U IO D EN,^%ZISC,END Q
|
---|
58 | S ZTRTN="EN^FHMMBRPT",ZTSAVE("FHSDT")="",ZTSAVE("FHEDT")=""
|
---|
59 | S ZTSAVE=("FHNDT")="",ZTSAVE=("FHPER")="",ZTSAVE("ZCO")=""
|
---|
60 | S ZTSAVE("CO")="",ZTSAVE("ALLMON")="",ZTSAVE("PG")="",ZTSAVE("EX")=""
|
---|
61 | S ZTSAVE("ZOUT")="",ZTSAVE("ALLADM")="",ZTSAVE("ALLFHPER")=""
|
---|
62 | S ZTSAVE("COXX")="",ZTSAVE("CONUMX")="",ZTSAVE("FHCOMM")=""
|
---|
63 | S ZTSAVE("CONAME")=""
|
---|
64 | S ZTDESC="Dietetics Monitor Report" D ^%ZTLOAD
|
---|
65 | D ^%ZISC K %ZIS,IOP
|
---|
66 | ;D END Q
|
---|
67 | ;
|
---|
68 | END ;kill and quit
|
---|
69 | K I,J,DFN,FHDFN,SSN,ADMTOT,MONTOT,FHPER,FHSDT,FHEDT,FHNDT,X,Y,PG
|
---|
70 | Q
|
---|
71 | ;
|
---|
72 | THEND ;
|
---|
73 | I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR
|
---|
74 | S NAME="ALL COMMUNICATION OFFICES " D HDR
|
---|
75 | W !!,"ALL TOTAL ADMISSIONS: ",?22,ALLADM
|
---|
76 | W !,"TOTAL WITH MONITORS:",?22,ALLMON
|
---|
77 | W !,"Percentage of Admissions with Monitors: "
|
---|
78 | I ALLADM=0!(ALLMON=0) W "0.0%" D END Q
|
---|
79 | S ALLFHPER=(ALLMON/ALLADM)*100
|
---|
80 | I $L($P(ALLFHPER,".",2))>2 S ALLFHPER=$P(ALLFHPER,".",1)_"."_$E($P(ALLFHPER,".",2),1,2)
|
---|
81 | W ALLFHPER,"%" I $Y>(IOSL-4) D PG I EX=U Q
|
---|
82 | G END Q
|
---|
83 | ;
|
---|
84 | N2 ;find Communications Office
|
---|
85 | S DIC=119.73,DIC(0)="AEQ",DIC("A")="Select Communication Offices: "
|
---|
86 | D ^DIC I (Y=-1)&(CO="") Q
|
---|
87 | I Y=-1 Q
|
---|
88 | S CON=$P(Y,"^",1),CO=CON_"^"_CO,CONAM=$P(Y,"^",2),CONAME=CONAM_"^"_CONAME S CONUMX=$L(CO,"^") G N2
|
---|
89 | I Y=-1 K DIC Q
|
---|
90 | Q
|
---|
91 | ;
|
---|
92 | PG ;
|
---|
93 | I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
|
---|
94 | D HDR Q
|
---|
95 | HDR ;Header
|
---|
96 | W:$Y @IOF W !,NAME,?30,"MONITOR BRIEF REPORT" W !,FHNDT,?60,"Page: " S PG=PG+1 W PG,!!
|
---|
97 | W "Admission",?13,"Patient",?39,"SSN",?45,"Monitor?",?56,"Discharge"
|
---|
98 | W ! F Z=1:1:79 W "="
|
---|
99 | Q
|
---|