Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHMMNADM

FHMMNADM.m

Go to the documentation of this file. 
  1. FHMMNADM ;Hines OIFO/JT,RTK,AAC - Multidiv Adm/Disc Monitor Report ;10/10/03  10:34
  1.  ;;5.5;DIETETICS;;Jan 28, 2005
  1.  ;
  1. COM ;Get Communication Offices
  1.  ;
  1.  S (XX,ZCO,CO,COXX,CNAME,CONAME,CONAM,WARD,FHCOMM)="",(ALLMON,ALLMV)=0
  1.  ;S ZZOUT=$G(^FH(119.73,0)),(CONUMX,ZOUT)=$P(ZZOUT,"^",4)
  1.  S ZZCOUNT=0 F ZZCOUNT=0:0 S ZZCOUNT=$O(^FH(119.73,ZZCOUNT)) Q:ZZCOUNT'>0  S ZOUT=ZZCOUNT
  1.  R !!,"Print report for all Communications Offices Y or N: ",ZCO:DTIME W ! S ZCO=$TR(ZCO,"y","Y")
  1.  I ZCO'="Y" D N2 I (Y=-1)&(CO="") Q
  1.  ;
  1. DATE ;sets date
  1.  ;
  1.  K %DT(0) S %DT="AEPT",%DT("A")="Enter beginning date: " D ^%DT Q:Y<0
  1.  S FHSDT=Y,%DT(0)=FHSDT,%DT("A")="Enter ending date: " D ^%DT Q:Y<0
  1.  S FHEDT=Y
  1.  S DIR(0)="SA^A:Admissions;D:Discharges"
  1.  S DIR("A")="Select type of movement for this report: " D ^DIR
  1.  Q:Y["^"!(Y="")  S TYP=Y
  1.  D DEV Q
  1.  ;
  1. EN ;get admission/monitor information
  1.  Q:XX="*"
  1.  I ZCO'="Y" S CONUMX=CONUMX-1 G:CONUMX=0 THEND  S COXX=$P(CO,"^",CONUMX),CNAME=$P(CONAME,"^",CONUMX)
  1.  I ZCO="Y" S COXX=COXX+1 G:COXX>ZOUT THEND  S CNAME=$G(^FH(119.73,COXX,0)),CNAME=$P(CNAME,"^")
  1.  I $D(^FH(119.73,COXX,"I"))!'$D(^FH(119.73,COXX,0)) G EN
  1.  ;
  1.  I TYP'="A" G EN1 Q
  1.  S PG=0,EX="",Y=DT X ^DD("DD") S FHNDT=Y D HDR
  1.  S MVTOT=0,MONTOT=0
  1.  S I=FHSDT F  S I=$O(^DGPM("ATT1",I)) Q:'I!(I>FHEDT)!(EX=U)  D 
  1.  .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 COFF2 Q:FHCOMM=""  Q:$D(^FH(119.73,FHCOMM,"I"))  Q:FHCOMM'=COXX  D
  1.  ..S ADM=J,ADMD=I D WRT
  1.  .Q
  1.  Q:XX="*"
  1.  D END
  1.  D EN
  1.  Q
  1.  ;
  1. COFF ;get communication offices
  1.  Q:'$D(^DIC(42,"B",WARD))
  1.  S WARDIEN=$O(^DIC(42,"B",WARD,""))
  1.  Q:'$D(^FH(119.6,"AW",WARDIEN))
  1.  S FHWARD=$O(^FH(119.6,"AW",WARDIEN,""))
  1.  S FHCOMM=$P($G(^FH(119.6,FHWARD,0)),"^",8)
  1.  Q
  1.  ;
  1. COFF2 ;
  1.  Q:'$D(^FH(119.6,"AW",WARD))
  1.  S FHWARD=$O(^FH(119.6,"AW",WARD,""))
  1.  S FHCOMM=$P($G(^FH(119.6,FHWARD,0)),"^",8)
  1.  Q
  1.  ;
  1. WRT ;write info
  1.  ; 
  1.  S DFN=$P(^DGPM(J,0),U,3) I $Y>(IOSL-4) D PG I EX=U S XX="*" Q
  1.  S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
  1.  S Y=$P(ADMD,".") X ^DD("DD") W !,Y,?13,$E($P($G(^DPT(DFN,0)),U,1),U,23)
  1.  W ?39,$E($P($G(^DPT(DFN,0)),U,9),6,9) S MVTOT=MVTOT+1
  1.  I $D(^FHPT(FHDFN,"A",ADM,"MO","B")) W ?48,"Yes" S MONTOT=MONTOT+1
  1.  S Y=$P($P($G(^FHPT(FHDFN,"A",ADM,0)),U,14),".",1) I Y X ^DD("DD") W ?56,Y
  1.  I $Y>(IOSL-4) D PG I EX=U S XX="*" Q
  1.  Q
  1.  ;
  1. EN1 ;discharges
  1.  S PG=0,EX="",Y=DT X ^DD("DD") S FHNDT=Y D HDR I EX=U S XX="*" Q
  1.  S MVTOT=0,MONTOT=0
  1.  S I=FHSDT F  S I=$O(^DGPM("ATT3",I)) Q:'I!(I>FHEDT)!(EX=U)  D
  1.  .S J=0 F  S J=$O(^DGPM("ATT3",I,J)) Q:'J!(EX=U)  S D0=J D WARD^DGPMUTL S WARD=X Q:WARD=""  D COFF Q:FHCOMM=""  Q:$D(^FH(119.73,FHCOMM,"I"))  Q:FHCOMM'=COXX  D
  1.  ..S ADM=$P(^DGPM(J,0),U,14)
  1.  ..S ADMD=$P(^DGPM(ADM,0),U,1) D WRT
  1.  .Q
  1.  D END
  1.  D EN Q
  1.  ;
  1. END ;end/kill/quit
  1.  ;
  1.  I EX=U Q
  1.  W !!,"TOTAL "_$S(TYP="A":"ADMISSIONS",TYP="D":"DISCHARGES")_": ",?22,MVTOT S ALLMV=ALLMV+MVTOT
  1.  W !,"TOTAL WITH MONITORS:",?22,MONTOT S ALLMON=ALLMON+MONTOT
  1.  S FHPER=0 I MONTOT>0,MVTOT>0 S FHPER=(MONTOT/MVTOT)*100
  1.  I $L($P(FHPER,".",2))>2 S FHPER=$P(FHPER,".",1)_"."_$E($P(FHPER,".",2),1,2)
  1.  W !,"Percentage of "
  1.  W $S(TYP="A":"Admissions",TYP="D":"Discharges")
  1.  W " with Monitors: ",FHPER,"%"
  1.  I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR
  1.  Q
  1.  ;
  1. THEND ;end/kill/quit
  1.  ;
  1.  I EX=U Q
  1.  S CNAME="ALL "
  1.  D HDR
  1.  W !!,"ALL TOTAL "_$S(TYP="A":"ADMISSIONS",TYP="D":"DISCHARGES")_": ",?22,ALLMV
  1.  W !,"TOTAL WITH MONITORS:",?22,ALLMON
  1.  S ALLFHPER=0 I ALLMON>0,ALLMV>0 S ALLFHPER=(ALLMON/ALLMV)*100
  1.  I $L($P(ALLFHPER,".",2))>2 S ALLFHPER=$P(ALLFHPER,".",1)_"."_$E($P(ALLFHPER,".",2),1,2)
  1.  W !,"Percentage of "
  1.  W $S(TYP="A":"Admissions",TYP="D":"Discharges")
  1.  W " with Monitors: ",ALLFHPER,"%"
  1.  Q
  1.  ;
  1.  ;
  1. DEV ;get device and set up queue
  1.  S TAG=$S(TYP="A":"EN",TYP="D":"EN")
  1.  K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
  1.  I '$D(IO("Q")) U IO D @TAG,^%ZISC Q
  1.  S ZTRTN=TAG_"^FHMMNADM",ZTSAVE("FHSDT")="",ZTSAVE("FHEDT")=""
  1.  S ZTSAVE("ZCO")="",ZTSAVE("COXX")="",ZTSAVE("CONUMX")="",ZTSAVE("ZOUT")="",ZTSAVE("XX")=""
  1.  S ZTSAVE("CNAME")="",ZTSAVE("FHCOMM")="",ZTSAVE("CO")="",ZTSAVE("CONAME")=""
  1.  S ZTSAVE("ALLMV")="",ZTSAVE("ALLMON")="",ZTSAVE("ALLFHPER")=""
  1.  S ZTSAVE("TYP")="",ZTDESC="Dietetics Monitor Report" D ^%ZTLOAD
  1.  W !,"Task #",ZTSK
  1.  D ^%ZISC K %ZIS,IOP Q
  1.  Q
  1.  ;
  1. KL ;
  1.  K I,J,DFN,FHDFN,SSN,MVTOT,MONTOT,FHPER,X,Y,PG,FHNDT,ADM,CO,CONAME,CONAM,WARD,FHCOMM,ALLMON,ALLMV
  1.  K TAG,DIR,%DT,ADDT Q
  1.  Q
  1.  ;
  1. N2 ;Find Communications Office
  1.  S DIC=119.73,DIC(0)="AEQ",DIC("A")="Select Communication Offices: "
  1.  D ^DIC I (Y=-1)&(CO="") Q
  1.  I Y=-1 Q
  1.  S CON=$P(Y,"^",1),CO=CON_"^"_CO,CONAM=$P(Y,"^",2),CONAME=CONAM_"^"_CONAME S CONUMX=$L(CO,"^") G N2
  1.  I Y=-1 K DIC Q
  1.  Q
  1.  ;
  1. PG ;
  1.  I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
  1.  D HDR Q
  1. HDR ;Header
  1.  ;
  1.  W:$Y @IOF
  1.  W !,"DIETETIC MONITOR REPORT (Monitoring "
  1.  W $S(TYP="A":"Admissions",TYP="D":"Discharges")_")"
  1.  W !,FHNDT,?60,"Page: " S PG=PG+1 W PG,!
  1.  W !,?5,"Communication Offices: ",CNAME,!!
  1.  W "Admission",?13,"Patient",?39,"SSN",?45,"Monitor?",?56,"Discharge"
  1.  W ! F Z=1:1:79 W "="
  1.  Q