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

ECXAADM.m

Go to the documentation of this file. 
  1. ECXAADM ;ALB/JAP - ADM Extract Audit Report ;3/13/19  10:40
  1.  ;;3.0;DSS EXTRACTS;**8,33,149,170,173,174**;Dec 22, 1997;Build 33
  1. EN ;entry point for ADM extract audit report
  1.  N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,DIRUT,DTOUT,DUOUT,ECXPORT,RCNT ;149
  1.  S ECXERR=0
  1.  ;ecxaud=0 for 'extract' audit
  1.  S ECXHEAD="ADM",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.  W !
  1.  D ADM^ECXDVSN(.ECXDIV,ECXALL,ECXSTART,ECXEND,.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.  S ECXPGM="PROCESS^ECXAADM",ECXDESC="ADM Extract Audit Report"
  1.  S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")=""
  1.  S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1  I $G(ECXPORT) D  Q  ;149 Section added
  1.  .K ^TMP($J,"ECXPORT")
  1.  .S ^TMP($J,"ECXPORT",0)="EXTRACT LOG #^MEDICAL CENTER DIVISION^DATE RANGE OF AUDIT^WARD <DSS DEPT.>^# OF ADMISSIONS^",RCNT=1 ;173
  1.  .D PROCESS
  1.  .D EXPDISP^ECXUTL1
  1.  .D AUDIT^ECXKILL
  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^ECXAADM
  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.802
  1.  N X,Y,W,DATE,DIV,IEN,TL,ORDER,SORD,GTOT,STOT,WARD,QQFLG,CNT,TSV,ASIH,NOTE ;170,173,174
  1.  K ^TMP($J,"ECXWARD"),^TMP($J,"ECXORDER")
  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 ward info in ^tmp($j,"ecxward" and ^tmp($j,"ecxorder"
  1.  D WARDS^ECXUTLA(ECXALL,.ECXDIV)
  1.  S W="" F  S W=$O(^TMP($J,"ECXWARD",W)) Q:W=""  D
  1.  .S DIV=$P(^TMP($J,"ECXWARD",W),U,3),GTOT(DIV)=0,TL(W)=0,ORDER="" D
  1.  ..F  S ORDER=$O(^TMP($J,"ECXORDER",DIV,ORDER)) Q:ORDER=""  I $D(^(ORDER,1)) S STOT(DIV,ORDER)=0
  1.  ;get records in date range and ward set
  1.  S IEN="" F  S IEN=$O(^ECX(727.802,"AC",ECXEXT,IEN)) Q:IEN=""  D  Q:QQFLG
  1.  .S DATE=$P(^ECX(727.802,IEN,0),U,9),WARD=$P(^(0),U,28),TSV=$P(^(0),U,29),ASIH=$S($P(^(0),U,8)="A":1,1:0) ;170,173 Add Treating Specialty Value and ASIH status
  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.  .;track missing wards
  1.  .I WARD="" D  ;170
  1.  ..S ^TMP($J,"MISWRD")=$G(^TMP($J,"MISWRD"))+1,^("MISWRD",IEN)=""
  1.  .;170 Track missing treating specialties
  1.  .I TSV="" D  ;170
  1.  ..S ^TMP($J,"MISTRT")=$G(^TMP($J,"MISTRT"))+1,^("MISTRT",IEN)="" ;170
  1.  .I ASIH S ^TMP($J,"ASIH")=$G(^TMP($J,"ASIH"))+1,^("ASIH",IEN)="" ;173 Count ASIH records
  1.  .I WARD=""!(TSV="")!(ASIH) Q  ;170,173 Don't process if missing ward or treating specialty or ASIH OTHER FACILITY
  1.  .;if ward is among those selected, then tally admission data
  1.  .I $D(TL(WARD)) S TL(WARD)=TL(WARD)+1,CNT=CNT+1
  1.  .I $D(ZTQUEUED),(CNT>499),'(CNT#500),$$S^%ZTLOAD S QQFLG=1,ZTSTOP=1 K ZTREQ
  1.  ;after all the extract records are processed, set totals into ^tmp($j,"ecxorder"
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
  1.  S W="" F  S W=$O(TL(W)) Q:W=""  D
  1.  .S ORDER=$P(^TMP($J,"ECXWARD",W),U,1),DIV=$P(^(W),U,3)
  1.  .S $P(^TMP($J,"ECXORDER",DIV,ORDER),U,3)=TL(W)
  1.  ;determine ward group subtotal and division grandtotal
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
  1.  S DIV="" F  S DIV=$O(^TMP($J,"ECXORDER",DIV)) Q:DIV=""  S GTOT(DIV)=0 D
  1.  .S ORDER="",STOT=0 F  S ORDER=$O(^TMP($J,"ECXORDER",DIV,ORDER)) Q:ORDER=""  D
  1.  ..S TOT=$P(^TMP($J,"ECXORDER",DIV,ORDER),U,3),STOT=STOT+TOT,GTOT(DIV)=GTOT(DIV)+TOT
  1.  ..I $D(^TMP($J,"ECXORDER",DIV,ORDER,1)) S $P(^(1),U,3)=STOT,STOT=0
  1.  D PRINT
  1.  I '$G(ECXPORT) D AUDIT^ECXKILL ;149
  1.  Q
  1.  ;
  1. PRINT ;print the admission data by division and ward order
  1.  N JJ,SS,LN,PG,QFLG,WRDNM,WRDTOT,GRPNM,GRPTOT,DATA,DATA1,DIC,DA,DR,DIR,DIVNM,MISTYPE ;149,170
  1.  N DIRUT,DTOUT,DUOUT,IEN,FAC,ADMDT
  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(GTOT(DIV)) Q:DIV=""  D  Q:QFLG
  1.  .S DIVNM=$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")"_$S($P(ECXDIV(DIV),U,6)'="":(" <"_$P(ECXDIV(DIV),U,6)_">"),1:"") ;149
  1.  .I '$G(ECXPORT) D HEADER Q:QFLG  ;149
  1.  .I GTOT(DIV)=0 D  Q
  1.  ..I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)=DIVNM_U_ECXARRAY("START")_" to "_ECXARRAY("END")_U_"No admission data extracted for this medical center division",RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1 Q  ;149
  1.  ..W !!,?5,"No admission data extracted for this medical center division.",!
  1.  .S ORDER="" F  S ORDER=$O(^TMP($J,"ECXORDER",DIV,ORDER)) Q:ORDER=""  D  Q:QFLG
  1.  ..S DATA=^TMP($J,"ECXORDER",DIV,ORDER) K DATA1 I $D(^(ORDER,1)) S DATA1=^(1)
  1.  ..S WRDNM=$P(DATA,U,2),WRDTOT=+$P(DATA,U,3)
  1.  ..;don't display inactive wards unless there is admission data
  1.  ..;don't attempt to group inactive/unordered wards
  1.  ..I ORDER>999990 K DATA1 I WRDTOT=0 Q
  1.  ..I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG  ;149
  1.  ..I '$G(ECXPORT) W !,?5,WRDNM,?45,$$RJ^XLFSTR(WRDTOT,5," ") ;149
  1.  ..I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)=ECXEXT_U_DIVNM_U_ECXARRAY("START")_" to "_ECXARRAY("END")_U_WRDNM_U_WRDTOT,RCNT=RCNT+1 ;149
  1.  ..;if data1 exists, then this is the end of a ward group so print group total
  1.  ..I $G(DATA1) D  Q:QFLG
  1.  ...S GRPNM=$P(DATA1,U,2),GRPTOT=$P(DATA1,U,3)
  1.  ...I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)="^^Ward group "_GRPNM_" subtotal:"_U_GRPTOT,RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1 Q  ;149
  1.  ...D:($Y+3>IOSL) HEADER Q:QFLG
  1.  ...W !,?40,"----------"
  1.  ...W !,"Ward group "_GRPNM_" subtotal:",?45,$$RJ^XLFSTR(GRPTOT,5," ")
  1.  ...D:($Y+3>IOSL) HEADER Q:QFLG
  1.  ...W !!
  1.  .I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG  ;149
  1.  .I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)="^^Division "_$P(ECXDIV(DIV),U,2)_U_"Grand Total:"_U_GTOT(DIV),RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1 Q  ;149
  1.  .W !!,"Division "_$P(ECXDIV(DIV),U,2)_" Grand Total:",?45,$$RJ^XLFSTR(GTOT(DIV),5," ")
  1.  ;print patients with missing wards or missing treating specialties
  1.  Q:QFLG  ;149 Stop if user entered "^"
  1.  S NOTE=0 ;174 Has note printed? (0-no, 1- yes)
  1.  F MISTYPE="MISWRD","MISTRT","ASIH" Q:QFLG  I $D(^TMP($J,MISTYPE)) D  ;170,173
  1.  .S DIV=MISTYPE,ECXDIV(DIV)="^^^^^*** "_$S(MISTYPE="MISWRD":"MISSING WARDS",MISTYPE="ASIH":"ASIH OTHER FACILITY",1:"MISSING TREATING SPECIALTIES")_" ***^" D:'$G(ECXPORT) HEADER Q:QFLG  ;149,170,173
  1.  .S WRDTOT=$G(^TMP($J,MISTYPE)) ;170
  1.  .I '$G(ECXPORT) D  ;149,170,173
  1.  ..W !,?5,$S(MISTYPE="MISWRD":"MISSING WARD",MISTYPE="ASIH":"ASIH OTHER FACILITY",1:"MISSING TREATING SPECIALTY"),?45,$$RJ^XLFSTR(WRDTOT,5," "),!! ;149,170,173
  1.  ..I 'NOTE D  S NOTE=1 ;173,174
  1.  ...W "NOTE: Records are generated in the extract for ASIH Other Facility" ;173,174
  1.  ...W !,"movement types.  If present in your facility, this report will display"
  1.  ...W !,"them.  Missing Wards and Treating Specialties for ASIH Other Facility",! ;173,174
  1.  ...W "patients REQUIRE NO ACTION because the patient is at another facility.",!! ;174
  1.  .I $G(ECXPORT) D  ;149,170
  1.  ..S ^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^^"_$S(MISTYPE="MISWRD":"MISSING WARD",MISTYPE="ASIH":"ASIH OTHER FACILITY",1:"MISSING TREATING SPECIALTY")_U_WRDTOT ;170,173
  1.  ..I 'NOTE D  S NOTE=1 ;173,174
  1.  ...S RCNT=RCNT+1 ;173
  1.  ...S ^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^NOTE: Records are generated in the extract for ASIH Other Facility Movement types.",RCNT=RCNT+1 ;173,174
  1.  ...S ^TMP($J,"ECXPORT",RCNT)="^If present in your facility, this report will display them.  Missing wards",RCNT=RCNT+1 ;173,174
  1.  ...S ^TMP($J,"ECXPORT",RCNT)="^and Treating Specialties for ASIH Other Facility patients REQUIRE NO ACTION because" ;173,174
  1.  ...S RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^the patient is at another facility." ;174
  1.  ..S RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^",RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^NAME^PATIENT DFN^FACILITY^ADMISSION DATE^ASIH OTHER FACILITY",RCNT=RCNT+1 ;170,173
  1.  .I '$G(ECXPORT) D HEAD ;149
  1.  .S IEN="" F  S IEN=$O(^TMP($J,MISTYPE,IEN)) Q:'IEN  D  I QFLG Q  ;170
  1.  ..S DATA=$G(^ECX(727.802,IEN,0)),ADMDT=$P(DATA,U,9) Q:DATA=""
  1.  ..S FAC=$P(DATA,U,4) S:FAC'="" FAC=$$GET1^DIQ(40.8,FAC,.01,"E") ;173
  1.  ..I $G(ECXPORT) S ^TMP($J,"ECXPORT",RCNT)="^"_$P(DATA,U,7)_U_$P(DATA,U,5)_U_FAC_U_$E(ADMDT,5,6)_"/"_$E(ADMDT,7,8)_"/"_$E(ADMDT,1,4)_" "_$E($P(DATA,U,34),1,2)_":"_$E($P(DATA,U,34),3,4)_U_$S($P(DATA,U,8)="A":"YES",1:"NO"),RCNT=RCNT+1 Q  ;149,173
  1.  ..W !?2,$P(DATA,U,7),?8,$P(DATA,U,5),?25,$E(FAC,1,14),?45
  1.  ..W $E(ADMDT,5,6)_"/"_$E(ADMDT,7,8)_"/"_$E(ADMDT,1,4)," "
  1.  ..W $E($P(DATA,U,34),1,2)_":"_$E($P(DATA,U,34),3,4)
  1.  ..W ?63,$S($P(DATA,U,8)="A":"YES",1:"NO") ;173
  1.  ..D:($Y+3>IOSL) HEADER,HEAD Q:QFLG
  1.  I $G(ECXPORT) Q  ;149
  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.  .W @IOF
  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.  W !,?2,"NAME",?8,"PATIENT DFN",?25,"FACILITY",?45,"ADMISSION DATE",?63,"ASIH OTHER FAC" ;173
  1.  W !,?2,"====",?8,"===========",?25,"========",?45,"==============",?63,"==============" ;173
  1.  Q
  1.  ;
  1.  N JJ,SS,DIR,DIRUT,DTOUT,DUOUT,DSSID
  1.  I $E(IOST)="C",'QFLG D  ;149 Stop if user entered "^"
  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.  S DSSID=$P(ECXDIV(DIV),U,6)
  1.  W:$Y!($E(IOST)="C") @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
  1.  I DSSID="" W !,"Medical Center Division: "_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")",?68,"Page: "_PG
  1.  I DSSID]"" W !,"Medical Center Division: "_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")"_" <"_DSSID_">",?68,"Page: "_PG
  1.  W !!,?5,"Ward <DSS Dept.>",?40,"# of Admissions"
  1.  W !,LN,!
  1.  Q