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

ECXANUR.m

Go to the documentation of this file. 
  1. ECXANUR ;ALB/JAP - NUR Extract Audit Report ;Oct 15, 1997
  1.  ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
  1.  ;
  1. EN ;entry point for NUR extract audit report
  1.  N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR
  1.  S ECXERR=0
  1.  ;ecxaud=0 for 'extract' audit
  1.  S ECXHEAD="NUR",ECXAUD=0
  1.  W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
  1.  ;select extract
  1.  D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
  1.  Q:ECXERR
  1.  ;determine if facility is multidivisional
  1.  S DIC="^DG(43,",DA=1,DR="11;",DIQ="ECX",DIQ(0)="I" D EN^DIQ1
  1.  I +ECX(43,1,11,"I")=0 S ECXALL=1
  1.  I +ECX(43,1,11,"I")=1 D
  1.  .W !!
  1.  .S DIR(0)="Y",DIR("A")="Do you want the "_ECXHEAD_" extract audit report for all divisions"
  1.  .S DIR("B")="NO" D ^DIR K DIR
  1.  .I $G(DIRUT) S ECXERR=1 Q
  1.  .;if y=0 i.e., 'no', then ecxall=0 i.e., 'selected'
  1.  .S ECXALL=Y
  1.  I ECXERR=1 D  Q
  1.  .W !!,?5,"Try again later... exiting.",!
  1.  .D AUDIT^ECXKILL
  1.  ;select divisions/sites; all divisions if ecxall=1
  1.  S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
  1.  D NUR^ECXDVSN1(.ECXDIV,ECXALL,.ECXERR)
  1.  I ECXERR=1 D  Q
  1.  .W !!,?5,"Try again later... exiting.",!
  1.  .D AUDIT^ECXKILL
  1.  ;determine output device and queue if requested
  1.  W !
  1.  S ECXPGM="PROCESS^ECXANUR",ECXDESC="NUR Extract Audit Report"
  1.  S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")=""
  1.  W !
  1.  D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
  1.  I ECXSAVE("POP")=1 D  Q
  1.  .W !!,?5,"Try again later... exiting.",!
  1.  .D AUDIT^ECXKILL
  1.  I ECXSAVE("ZTSK")=0 D
  1.  .K ECXSAVE,ECXPGM,ECXDESC
  1.  .D PROCESS^ECXANUR
  1.  I IO'=IO(0) D ^%ZISC
  1.  D HOME^%ZIS
  1.  D AUDIT^ECXKILL
  1.  Q
  1.  ;
  1. PROCESS ;process data in file #727.805
  1.  N X,Y,W,DATA,DATE,DIV,IEN,LOC,PAT,BD,BDS,QQFLG,CNT
  1.  K ^TMP($J,"ECXAUD")
  1.  S (CNT,QQFLG)=0
  1.  S ECXEXT=ECXARRAY("EXTRACT"),ECXDEF=ECXARRAY("DEF")
  1.  S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
  1.  ;get run date in external format
  1.  D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
  1.  ;get records in date range and ward set
  1.  S IEN="" F  S IEN=$O(^ECX(727.805,"AC",ECXEXT,IEN)) Q:IEN=""  D
  1.  .S DATA=^ECX(727.805,IEN,0),DATE=$P(DATA,U,9),LOC=$P(DATA,U,13)
  1.  .;convert free text date to fm internal format date
  1.  .S $E(DATE,1,2)=$E(DATE,1,2)-17
  1.  .Q:$L(DATE)<7  Q:(DATE<ECXSTART)  Q:(DATE>ECXEND)
  1.  .;if ward is among those selected, then tally nursing data
  1.  .I $D(ECXDIV(LOC)) D
  1.  ..S DIV="",DIV=$O(ECXDIV(LOC,DIV))
  1.  ..S PAT=$P(DATA,U,10),BD=$P(DATA,U,14)
  1.  ..I '$D(^TMP($J,"ECXAUD",DIV,LOC,BD,PAT)) S ^TMP($J,"ECXAUD",DIV,LOC,BD,PAT)=0
  1.  ..S ^(PAT)=^TMP($J,"ECXAUD",DIV,LOC,BD,PAT)+1,CNT=CNT+1
  1.  ..I $D(ZTQUEUED),(CNT>499),'(CNT#500),$$S^%ZTLOAD S QQFLG=1,ZTSTOP=1 K ZTREQ
  1.  ;after all extract records processed, get bedsection names for printing
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
  1.  S IEN=0 F  S IEN=$O(^NURSF(213.3,IEN)) Q:+IEN=0  S BDS(IEN)=$P(^NURSF(213.3,IEN,0),U,1)
  1.  ;print the report
  1.  D PRINT
  1.  D AUDIT^ECXKILL
  1.  Q
  1.  ;
  1. PRINT ;print the nursing classification data by division and location order
  1.  N JJ,SS,LN,NM,BDNM,NLNM,DIV,DIVNM,LOC,PG,QFLG,BTOT,GTOT,STOT,DIR,DIRUT,DTOUT,DUOUT
  1.  U IO
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
  1.  S (QFLG,PG)=0,$P(LN,"-",80)="",DIV=""
  1.  F  S DIV=$O(ECXDIV("D",DIV)) Q:DIV=""  D  Q:QFLG
  1.  .S DIVNM=$P(ECXDIV("D",DIV),U,2)_" ("_$P(ECXDIV("D",DIV),U,3)_")" D HEADER
  1.  .I '$D(^TMP($J,"ECXAUD",DIV)) D  Q
  1.  ..W !!,?3,"No data available for this division.",!!
  1.  .F JJ=1:1:5 S GTOT(JJ)=0,GTOT("T")=0
  1.  .I $D(^TMP($J,"ECXAUD",DIV)) S LOC="" F  S LOC=$O(^TMP($J,"ECXAUD",DIV,LOC)) Q:LOC=""  D  Q:QFLG
  1.  ..F JJ=1:1:5 S STOT(JJ)=0,STOT("T")=0
  1.  ..S NLNM=$P(ECXDIV(LOC,DIV),U,2)_" ("_LOC_")",BD=""
  1.  ..D:($Y+3>IOSL) HEADER Q:QFLG  W !,NLNM
  1.  ..F  S BD=$O(^TMP($J,"ECXAUD",DIV,LOC,BD)) Q:BD=""  D  Q:QFLG
  1.  ...F PAT=1:1:5 S TOT(PAT)=+$G(^TMP($J,"ECXAUD",DIV,LOC,BD,PAT))
  1.  ...S BDNM=BDS(BD),BDNM=$E(BDNM,1,22)_" ("_BD_")",BTOT=0 F JJ=1:1:5 S BTOT=BTOT+TOT(JJ)
  1.  ...;write the bedsection totals
  1.  ...D:($Y+3>IOSL) HEADER Q:QFLG
  1.  ...W !,?3,BDNM,?33,$$RJ^XLFSTR(TOT(1),5," "),?41,$$RJ^XLFSTR(TOT(2),5," "),?50,$$RJ^XLFSTR(TOT(3),5," "),?57,$$RJ^XLFSTR(TOT(4),5," "),?64,$$RJ^XLFSTR(TOT(5),5," "),?74,$$RJ^XLFSTR(BTOT,5," ")
  1.  ...;increment grand total and subtotal
  1.  ...F JJ=1:1:5 S GTOT(JJ)=GTOT(JJ)+TOT(JJ),STOT(JJ)=STOT(JJ)+TOT(JJ)
  1.  ...S GTOT("T")=GTOT("T")+BTOT,STOT("T")=STOT("T")+BTOT
  1.  ..;write the location subtotals
  1.  ..D:($Y+3>IOSL) HEADER Q:QFLG  W !,?33,$E(LN,1,46)
  1.  ..D:($Y+3>IOSL) HEADER Q:QFLG  W !,"Sub-totals for Location ("_LOC_"):"
  1.  ..W ?33,$$RJ^XLFSTR(STOT(1),5," "),?41,$$RJ^XLFSTR(STOT(2),5," "),?50,$$RJ^XLFSTR(STOT(3),5," "),?57,$$RJ^XLFSTR(STOT(4),5," "),?64,$$RJ^XLFSTR(STOT(5),5," "),?74,$$RJ^XLFSTR(STOT("T"),5," ")
  1.  ..D:($Y+3>IOSL) HEADER Q:QFLG  W !!
  1.  .;write the division grand totals
  1.  .D:($Y+3>IOSL) HEADER Q:QFLG  W !!,"Grand Totals for "_DIVNM_":"
  1.  .W ?33,$$RJ^XLFSTR(GTOT(1),5," "),?41,$$RJ^XLFSTR(GTOT(2),5," "),?50,$$RJ^XLFSTR(GTOT(3),5," "),?57,$$RJ^XLFSTR(GTOT(4),5," "),?64,$$RJ^XLFSTR(GTOT(5),5," "),?74,$$RJ^XLFSTR(GTOT("T"),5," ")
  1.  ;print the audit descriptive narrative
  1.  I $E(IOST)'="C" D
  1.  .W @IOF S PG=PG+1
  1.  .W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
  1.  .W !,"DSS Extract Log #:       "_ECXEXT
  1.  .W !,"Date Range of Audit:     "_ECXARRAY("START")_" to "_ECXARRAY("END")
  1.  .W !,"Report Run Date/Time:    "_ECXRUN,?68,"Page: ",PG
  1.  .W !!,LN,!!
  1.  .S DIC="^ECX(727.1,",DA=ECXARRAY("DEF"),DR="1" D EN^DIQ
  1.  I $E(IOST)="C",'QFLG D
  1.  .S SS=22-$Y F JJ=1:1:SS W !
  1.  .S DIR(0)="E" W ! D ^DIR K DIR
  1.  Q
  1.  ;
  1.  N JJ,SS
  1.  I $E(IOST)="C" D
  1.  .S SS=22-$Y F JJ=1:1:SS W !
  1.  .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
  1.  Q:QFLG
  1.  W:$Y!($E(IOST)="C") @IOF S PG=PG+1
  1.  W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
  1.  W !,"DSS Extract Log #:       "_ECXARRAY("EXTRACT")
  1.  W !,"Date Range of Audit:     "_ECXARRAY("START")_" to "_ECXARRAY("END")
  1.  W !,"Report Run Date/Time:    "_ECXRUN
  1.  W !,"Medical Center Division: "_$P(ECXDIV("D",DIV),U,2)_" ("_$P(ECXDIV("D",DIV),U,3)_")",?68,"Page: "_PG
  1.  W !!,"Nursing Location",?36,"Patients per Acuity Level (Category)"
  1.  W !,?3,"Nursing Bedsection",?37,"I",?44,"II",?52,"III",?60,"IV",?68,"V",?74,"Total"
  1.  W !,LN,!
  1.  Q