ECXAADM ;ALB/JAP - ADM Extract Audit Report ;3/13/19 10:40
;;3.0;DSS EXTRACTS;**8,33,149,170,173,174**;Dec 22, 1997;Build 33
EN ;entry point for ADM extract audit report
N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,DIRUT,DTOUT,DUOUT,ECXPORT,RCNT ;149
S ECXERR=0
;ecxaud=0 for 'extract' audit
S ECXHEAD="ADM",ECXAUD=0
W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
;select extract
D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
Q:ECXERR
;determine if facility is multidivisional
S DIC="^DG(43,",DA=1,DR="11;",DIQ="ECX",DIQ(0)="I" D EN^DIQ1
I +ECX(43,1,11,"I")=0 S ECXALL=1
I +ECX(43,1,11,"I")=1 D
.W !!
.S DIR(0)="Y",DIR("A")="Do you want the "_ECXHEAD_" extract audit report for all divisions"
.S DIR("B")="NO" D ^DIR K DIR
.I $G(DIRUT) S ECXERR=1 Q
.;if y=0 i.e., 'no', then ecxall=0 i.e., 'selected'
.S ECXALL=Y
I ECXERR=1 D Q
.W !!,?5,"Try again later... exiting.",!
.D AUDIT^ECXKILL
;select divisions/sites; all divisions if ecxall=1
S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
W !
D ADM^ECXDVSN(.ECXDIV,ECXALL,ECXSTART,ECXEND,.ECXERR)
I ECXERR=1 D Q
.W !!,?5,"Try again later... exiting.",!
.D AUDIT^ECXKILL
;determine output device and queue if requested
S ECXPGM="PROCESS^ECXAADM",ECXDESC="ADM Extract Audit Report"
S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")=""
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q ;149 Section added
.K ^TMP($J,"ECXPORT")
.S ^TMP($J,"ECXPORT",0)="EXTRACT LOG #^MEDICAL CENTER DIVISION^DATE RANGE OF AUDIT^WARD <DSS DEPT.>^# OF ADMISSIONS^",RCNT=1 ;173
.D PROCESS
.D EXPDISP^ECXUTL1
.D AUDIT^ECXKILL
W !
D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
I ECXSAVE("POP")=1 D Q
.W !!,?5,"Try again later... exiting.",!
.D AUDIT^ECXKILL
I ECXSAVE("ZTSK")=0 D
.K ECXSAVE,ECXPGM,ECXDESC
.D PROCESS^ECXAADM
I IO'=IO(0) D ^%ZISC
D HOME^%ZIS
D AUDIT^ECXKILL
Q
;
PROCESS ;process data in file #727.802
N X,Y,W,DATE,DIV,IEN,TL,ORDER,SORD,GTOT,STOT,WARD,QQFLG,CNT,TSV,ASIH,NOTE ;170,173,174
K ^TMP($J,"ECXWARD"),^TMP($J,"ECXORDER")
S (CNT,QQFLG)=0
S ECXEXT=ECXARRAY("EXTRACT"),ECXDEF=ECXARRAY("DEF")
S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
;get run date in external format
D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
;get ward info in ^tmp($j,"ecxward" and ^tmp($j,"ecxorder"
D WARDS^ECXUTLA(ECXALL,.ECXDIV)
S W="" F S W=$O(^TMP($J,"ECXWARD",W)) Q:W="" D
.S DIV=$P(^TMP($J,"ECXWARD",W),U,3),GTOT(DIV)=0,TL(W)=0,ORDER="" D
..F S ORDER=$O(^TMP($J,"ECXORDER",DIV,ORDER)) Q:ORDER="" I $D(^(ORDER,1)) S STOT(DIV,ORDER)=0
;get records in date range and ward set
S IEN="" F S IEN=$O(^ECX(727.802,"AC",ECXEXT,IEN)) Q:IEN="" D Q:QQFLG
.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
.;convert free text date to fm internal format date
.S $E(DATE,1,2)=$E(DATE,1,2)-17
.Q:$L(DATE)<7 Q:(DATE<ECXSTART) Q:(DATE>ECXEND)
.;track missing wards
.I WARD="" D ;170
..S ^TMP($J,"MISWRD")=$G(^TMP($J,"MISWRD"))+1,^("MISWRD",IEN)=""
.;170 Track missing treating specialties
.I TSV="" D ;170
..S ^TMP($J,"MISTRT")=$G(^TMP($J,"MISTRT"))+1,^("MISTRT",IEN)="" ;170
.I ASIH S ^TMP($J,"ASIH")=$G(^TMP($J,"ASIH"))+1,^("ASIH",IEN)="" ;173 Count ASIH records
.I WARD=""!(TSV="")!(ASIH) Q ;170,173 Don't process if missing ward or treating specialty or ASIH OTHER FACILITY
.;if ward is among those selected, then tally admission data
.I $D(TL(WARD)) S TL(WARD)=TL(WARD)+1,CNT=CNT+1
.I $D(ZTQUEUED),(CNT>499),'(CNT#500),$$S^%ZTLOAD S QQFLG=1,ZTSTOP=1 K ZTREQ
;after all the extract records are processed, set totals into ^tmp($j,"ecxorder"
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
S W="" F S W=$O(TL(W)) Q:W="" D
.S ORDER=$P(^TMP($J,"ECXWARD",W),U,1),DIV=$P(^(W),U,3)
.S $P(^TMP($J,"ECXORDER",DIV,ORDER),U,3)=TL(W)
;determine ward group subtotal and division grandtotal
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
S DIV="" F S DIV=$O(^TMP($J,"ECXORDER",DIV)) Q:DIV="" S GTOT(DIV)=0 D
.S ORDER="",STOT=0 F S ORDER=$O(^TMP($J,"ECXORDER",DIV,ORDER)) Q:ORDER="" D
..S TOT=$P(^TMP($J,"ECXORDER",DIV,ORDER),U,3),STOT=STOT+TOT,GTOT(DIV)=GTOT(DIV)+TOT
..I $D(^TMP($J,"ECXORDER",DIV,ORDER,1)) S $P(^(1),U,3)=STOT,STOT=0
D PRINT
I '$G(ECXPORT) D AUDIT^ECXKILL ;149
Q
;
PRINT ;print the admission data by division and ward order
N JJ,SS,LN,PG,QFLG,WRDNM,WRDTOT,GRPNM,GRPTOT,DATA,DATA1,DIC,DA,DR,DIR,DIVNM,MISTYPE ;149,170
N DIRUT,DTOUT,DUOUT,IEN,FAC,ADMDT
U IO
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
S (QFLG,PG)=0,$P(LN,"-",80)="",DIV=""
F S DIV=$O(GTOT(DIV)) Q:DIV="" D Q:QFLG
.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
.I '$G(ECXPORT) D HEADER Q:QFLG ;149
.I GTOT(DIV)=0 D Q
..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
..W !!,?5,"No admission data extracted for this medical center division.",!
.S ORDER="" F S ORDER=$O(^TMP($J,"ECXORDER",DIV,ORDER)) Q:ORDER="" D Q:QFLG
..S DATA=^TMP($J,"ECXORDER",DIV,ORDER) K DATA1 I $D(^(ORDER,1)) S DATA1=^(1)
..S WRDNM=$P(DATA,U,2),WRDTOT=+$P(DATA,U,3)
..;don't display inactive wards unless there is admission data
..;don't attempt to group inactive/unordered wards
..I ORDER>999990 K DATA1 I WRDTOT=0 Q
..I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG ;149
..I '$G(ECXPORT) W !,?5,WRDNM,?45,$$RJ^XLFSTR(WRDTOT,5," ") ;149
..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
..;if data1 exists, then this is the end of a ward group so print group total
..I $G(DATA1) D Q:QFLG
...S GRPNM=$P(DATA1,U,2),GRPTOT=$P(DATA1,U,3)
...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
...D:($Y+3>IOSL) HEADER Q:QFLG
...W !,?40,"----------"
...W !,"Ward group "_GRPNM_" subtotal:",?45,$$RJ^XLFSTR(GRPTOT,5," ")
...D:($Y+3>IOSL) HEADER Q:QFLG
...W !!
.I '$G(ECXPORT) D:($Y+3>IOSL) HEADER Q:QFLG ;149
.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
.W !!,"Division "_$P(ECXDIV(DIV),U,2)_" Grand Total:",?45,$$RJ^XLFSTR(GTOT(DIV),5," ")
;print patients with missing wards or missing treating specialties
Q:QFLG ;149 Stop if user entered "^"
S NOTE=0 ;174 Has note printed? (0-no, 1- yes)
F MISTYPE="MISWRD","MISTRT","ASIH" Q:QFLG I $D(^TMP($J,MISTYPE)) D ;170,173
.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
.S WRDTOT=$G(^TMP($J,MISTYPE)) ;170
.I '$G(ECXPORT) D ;149,170,173
..W !,?5,$S(MISTYPE="MISWRD":"MISSING WARD",MISTYPE="ASIH":"ASIH OTHER FACILITY",1:"MISSING TREATING SPECIALTY"),?45,$$RJ^XLFSTR(WRDTOT,5," "),!! ;149,170,173
..I 'NOTE D S NOTE=1 ;173,174
...W "NOTE: Records are generated in the extract for ASIH Other Facility" ;173,174
...W !,"movement types. If present in your facility, this report will display"
...W !,"them. Missing Wards and Treating Specialties for ASIH Other Facility",! ;173,174
...W "patients REQUIRE NO ACTION because the patient is at another facility.",!! ;174
.I $G(ECXPORT) D ;149,170
..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
..I 'NOTE D S NOTE=1 ;173,174
...S RCNT=RCNT+1 ;173
...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
...S ^TMP($J,"ECXPORT",RCNT)="^If present in your facility, this report will display them. Missing wards",RCNT=RCNT+1 ;173,174
...S ^TMP($J,"ECXPORT",RCNT)="^and Treating Specialties for ASIH Other Facility patients REQUIRE NO ACTION because" ;173,174
...S RCNT=RCNT+1,^TMP($J,"ECXPORT",RCNT)="^the patient is at another facility." ;174
..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
.I '$G(ECXPORT) D HEAD ;149
.S IEN="" F S IEN=$O(^TMP($J,MISTYPE,IEN)) Q:'IEN D I QFLG Q ;170
..S DATA=$G(^ECX(727.802,IEN,0)),ADMDT=$P(DATA,U,9) Q:DATA=""
..S FAC=$P(DATA,U,4) S:FAC'="" FAC=$$GET1^DIQ(40.8,FAC,.01,"E") ;173
..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
..W !?2,$P(DATA,U,7),?8,$P(DATA,U,5),?25,$E(FAC,1,14),?45
..W $E(ADMDT,5,6)_"/"_$E(ADMDT,7,8)_"/"_$E(ADMDT,1,4)," "
..W $E($P(DATA,U,34),1,2)_":"_$E($P(DATA,U,34),3,4)
..W ?63,$S($P(DATA,U,8)="A":"YES",1:"NO") ;173
..D:($Y+3>IOSL) HEADER,HEAD Q:QFLG
I $G(ECXPORT) Q ;149
I $E(IOST)'="C" D
.W @IOF S PG=PG+1
.W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
.W !,"DSS Extract Log #: "_ECXEXT
.W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
.W !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG
.W !!,LN,!!
.S DIC="^ECX(727.1,",DA=ECXARRAY("DEF"),DR="1" D EN^DIQ
.W @IOF
I $E(IOST)="C",'QFLG D
.S SS=22-$Y F JJ=1:1:SS W !
.S DIR(0)="E" W ! D ^DIR K DIR
Q
;
HEAD ;173 header for missing wards, treating specialties, and ASIH OTHER FACILITY
W !,?2,"NAME",?8,"PATIENT DFN",?25,"FACILITY",?45,"ADMISSION DATE",?63,"ASIH OTHER FAC" ;173
W !,?2,"====",?8,"===========",?25,"========",?45,"==============",?63,"==============" ;173
Q
;
N JJ,SS,DIR,DIRUT,DTOUT,DUOUT,DSSID
I $E(IOST)="C",'QFLG D ;149 Stop if user entered "^"
.S SS=22-$Y F JJ=1:1:SS W !
.I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
Q:QFLG
S DSSID=$P(ECXDIV(DIV),U,6)
W:$Y!($E(IOST)="C") @IOF S PG=PG+1
W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
W !,"DSS Extract Log #: "_ECXEXT
W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
W !,"Report Run Date/Time: "_ECXRUN
I DSSID="" W !,"Medical Center Division: "_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")",?68,"Page: "_PG
I DSSID]"" W !,"Medical Center Division: "_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")"_" <"_DSSID_">",?68,"Page: "_PG
W !!,?5,"Ward <DSS Dept.>",?40,"# of Admissions"
W !,LN,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXAADM 11067 printed Sep 23, 2025@19:27:56 Page 2
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
EN ;entry point for ADM extract audit report
+1 ;149
NEW %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,DIRUT,DTOUT,DUOUT,ECXPORT,RCNT
+2 SET ECXERR=0
+3 ;ecxaud=0 for 'extract' audit
+4 SET ECXHEAD="ADM"
SET ECXAUD=0
+5 WRITE !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
+6 ;select extract
+7 DO AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
+8 if ECXERR
QUIT
+9 ;determine if facility is multidivisional
+10 SET DIC="^DG(43,"
SET DA=1
SET DR="11;"
SET DIQ="ECX"
SET DIQ(0)="I"
DO EN^DIQ1
+11 IF +ECX(43,1,11,"I")=0
SET ECXALL=1
+12 IF +ECX(43,1,11,"I")=1
Begin DoDot:1
+13 WRITE !!
+14 SET DIR(0)="Y"
SET DIR("A")="Do you want the "_ECXHEAD_" extract audit report for all divisions"
+15 SET DIR("B")="NO"
DO ^DIR
KILL DIR
+16 IF $GET(DIRUT)
SET ECXERR=1
QUIT
+17 ;if y=0 i.e., 'no', then ecxall=0 i.e., 'selected'
+18 SET ECXALL=Y
End DoDot:1
+19 IF ECXERR=1
Begin DoDot:1
+20 WRITE !!,?5,"Try again later... exiting.",!
+21 DO AUDIT^ECXKILL
End DoDot:1
QUIT
+22 ;select divisions/sites; all divisions if ecxall=1
+23 SET X=ECXARRAY("START")
DO ^%DT
SET ECXSTART=Y
SET X=ECXARRAY("END")
DO ^%DT
SET ECXEND=Y
+24 WRITE !
+25 DO ADM^ECXDVSN(.ECXDIV,ECXALL,ECXSTART,ECXEND,.ECXERR)
+26 IF ECXERR=1
Begin DoDot:1
+27 WRITE !!,?5,"Try again later... exiting.",!
+28 DO AUDIT^ECXKILL
End DoDot:1
QUIT
+29 ;determine output device and queue if requested
+30 SET ECXPGM="PROCESS^ECXAADM"
SET ECXDESC="ADM Extract Audit Report"
+31 SET ECXSAVE("ECXHEAD")=""
SET ECXSAVE("ECXALL")=""
SET ECXSAVE("ECXDIV(")=""
SET ECXSAVE("ECXARRAY(")=""
+32 ;149 Section added
SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
IF $GET(ECXPORT)
Begin DoDot:1
+33 KILL ^TMP($JOB,"ECXPORT")
+34 ;173
SET ^TMP($JOB,"ECXPORT",0)="EXTRACT LOG #^MEDICAL CENTER DIVISION^DATE RANGE OF AUDIT^WARD <DSS DEPT.>^# OF ADMISSIONS^"
SET RCNT=1
+35 DO PROCESS
+36 DO EXPDISP^ECXUTL1
+37 DO AUDIT^ECXKILL
End DoDot:1
QUIT
+38 WRITE !
+39 DO DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
+40 IF ECXSAVE("POP")=1
Begin DoDot:1
+41 WRITE !!,?5,"Try again later... exiting.",!
+42 DO AUDIT^ECXKILL
End DoDot:1
QUIT
+43 IF ECXSAVE("ZTSK")=0
Begin DoDot:1
+44 KILL ECXSAVE,ECXPGM,ECXDESC
+45 DO PROCESS^ECXAADM
End DoDot:1
+46 IF IO'=IO(0)
DO ^%ZISC
+47 DO HOME^%ZIS
+48 DO AUDIT^ECXKILL
+49 QUIT
+50 ;
PROCESS ;process data in file #727.802
+1 ;170,173,174
NEW X,Y,W,DATE,DIV,IEN,TL,ORDER,SORD,GTOT,STOT,WARD,QQFLG,CNT,TSV,ASIH,NOTE
+2 KILL ^TMP($JOB,"ECXWARD"),^TMP($JOB,"ECXORDER")
+3 SET (CNT,QQFLG)=0
+4 SET ECXEXT=ECXARRAY("EXTRACT")
SET ECXDEF=ECXARRAY("DEF")
+5 SET X=ECXARRAY("START")
DO ^%DT
SET ECXSTART=Y
SET X=ECXARRAY("END")
DO ^%DT
SET ECXEND=Y
+6 ;get run date in external format
+7 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET ECXRUN=Y
+8 ;get ward info in ^tmp($j,"ecxward" and ^tmp($j,"ecxorder"
+9 DO WARDS^ECXUTLA(ECXALL,.ECXDIV)
+10 SET W=""
FOR
SET W=$ORDER(^TMP($JOB,"ECXWARD",W))
if W=""
QUIT
Begin DoDot:1
+11 SET DIV=$PIECE(^TMP($JOB,"ECXWARD",W),U,3)
SET GTOT(DIV)=0
SET TL(W)=0
SET ORDER=""
Begin DoDot:2
+12 FOR
SET ORDER=$ORDER(^TMP($JOB,"ECXORDER",DIV,ORDER))
if ORDER=""
QUIT
IF $DATA(^(ORDER,1))
SET STOT(DIV,ORDER)=0
End DoDot:2
End DoDot:1
+13 ;get records in date range and ward set
+14 SET IEN=""
FOR
SET IEN=$ORDER(^ECX(727.802,"AC",ECXEXT,IEN))
if IEN=""
QUIT
Begin DoDot:1
+15 ;170,173 Add Treating Specialty Value and ASIH status
SET DATE=$PIECE(^ECX(727.802,IEN,0),U,9)
SET WARD=$PIECE(^(0),U,28)
SET TSV=$PIECE(^(0),U,29)
SET ASIH=$SELECT($PIECE(^(0),U,8)="A":1,1:0)
+16 ;convert free text date to fm internal format date
+17 SET $EXTRACT(DATE,1,2)=$EXTRACT(DATE,1,2)-17
+18 if $LENGTH(DATE)<7
QUIT
if (DATE<ECXSTART)
QUIT
if (DATE>ECXEND)
QUIT
+19 ;track missing wards
+20 ;170
IF WARD=""
Begin DoDot:2
+21 SET ^TMP($JOB,"MISWRD")=$GET(^TMP($JOB,"MISWRD"))+1
SET ^("MISWRD",IEN)=""
End DoDot:2
+22 ;170 Track missing treating specialties
+23 ;170
IF TSV=""
Begin DoDot:2
+24 ;170
SET ^TMP($JOB,"MISTRT")=$GET(^TMP($JOB,"MISTRT"))+1
SET ^("MISTRT",IEN)=""
End DoDot:2
+25 ;173 Count ASIH records
IF ASIH
SET ^TMP($JOB,"ASIH")=$GET(^TMP($JOB,"ASIH"))+1
SET ^("ASIH",IEN)=""
+26 ;170,173 Don't process if missing ward or treating specialty or ASIH OTHER FACILITY
IF WARD=""!(TSV="")!(ASIH)
QUIT
+27 ;if ward is among those selected, then tally admission data
+28 IF $DATA(TL(WARD))
SET TL(WARD)=TL(WARD)+1
SET CNT=CNT+1
+29 IF $DATA(ZTQUEUED)
IF (CNT>499)
IF '(CNT#500)
IF $$S^%ZTLOAD
SET QQFLG=1
SET ZTSTOP=1
KILL ZTREQ
End DoDot:1
if QQFLG
QUIT
+30 ;after all the extract records are processed, set totals into ^tmp($j,"ecxorder"
+31 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
KILL ZTREQ
QUIT
+32 SET W=""
FOR
SET W=$ORDER(TL(W))
if W=""
QUIT
Begin DoDot:1
+33 SET ORDER=$PIECE(^TMP($JOB,"ECXWARD",W),U,1)
SET DIV=$PIECE(^(W),U,3)
+34 SET $PIECE(^TMP($JOB,"ECXORDER",DIV,ORDER),U,3)=TL(W)
End DoDot:1
+35 ;determine ward group subtotal and division grandtotal
+36 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
KILL ZTREQ
QUIT
+37 SET DIV=""
FOR
SET DIV=$ORDER(^TMP($JOB,"ECXORDER",DIV))
if DIV=""
QUIT
SET GTOT(DIV)=0
Begin DoDot:1
+38 SET ORDER=""
SET STOT=0
FOR
SET ORDER=$ORDER(^TMP($JOB,"ECXORDER",DIV,ORDER))
if ORDER=""
QUIT
Begin DoDot:2
+39 SET TOT=$PIECE(^TMP($JOB,"ECXORDER",DIV,ORDER),U,3)
SET STOT=STOT+TOT
SET GTOT(DIV)=GTOT(DIV)+TOT
+40 IF $DATA(^TMP($JOB,"ECXORDER",DIV,ORDER,1))
SET $PIECE(^(1),U,3)=STOT
SET STOT=0
End DoDot:2
End DoDot:1
+41 DO PRINT
+42 ;149
IF '$GET(ECXPORT)
DO AUDIT^ECXKILL
+43 QUIT
+44 ;
PRINT ;print the admission data by division and ward order
+1 ;149,170
NEW JJ,SS,LN,PG,QFLG,WRDNM,WRDTOT,GRPNM,GRPTOT,DATA,DATA1,DIC,DA,DR,DIR,DIVNM,MISTYPE
+2 NEW DIRUT,DTOUT,DUOUT,IEN,FAC,ADMDT
+3 USE IO
+4 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
KILL ZTREQ
QUIT
+5 SET (QFLG,PG)=0
SET $PIECE(LN,"-",80)=""
SET DIV=""
+6 FOR
SET DIV=$ORDER(GTOT(DIV))
if DIV=""
QUIT
Begin DoDot:1
+7 ;149
SET DIVNM=$PIECE(ECXDIV(DIV),U,2)_" ("_$PIECE(ECXDIV(DIV),U,3)_")"_$SELECT($PIECE(ECXDIV(DIV),U,6)'="":(" <"_$PIECE(ECXDIV(DIV),U,6)_">"),1:"")
+8 ;149
IF '$GET(ECXPORT)
DO HEADER
if QFLG
QUIT
+9 IF GTOT(DIV)=0
Begin DoDot:2
+10 ;149
IF $GET(ECXPORT)
SET ^TMP($JOB,"ECXPORT",RCNT)=DIVNM_U_ECXARRAY("START")_" to "_ECXARRAY("END")_U_"No admission data extracted for this medical center division"
SET RCNT=RCNT+1
SET ^TMP($JOB,"ECXPORT",RCNT)="^"
SET RCNT=RCNT+1
QUIT
+11 WRITE !!,?5,"No admission data extracted for this medical center division.",!
End DoDot:2
QUIT
+12 SET ORDER=""
FOR
SET ORDER=$ORDER(^TMP($JOB,"ECXORDER",DIV,ORDER))
if ORDER=""
QUIT
Begin DoDot:2
+13 SET DATA=^TMP($JOB,"ECXORDER",DIV,ORDER)
KILL DATA1
IF $DATA(^(ORDER,1))
SET DATA1=^(1)
+14 SET WRDNM=$PIECE(DATA,U,2)
SET WRDTOT=+$PIECE(DATA,U,3)
+15 ;don't display inactive wards unless there is admission data
+16 ;don't attempt to group inactive/unordered wards
+17 IF ORDER>999990
KILL DATA1
IF WRDTOT=0
QUIT
+18 ;149
IF '$GET(ECXPORT)
if ($Y+3>IOSL)
DO HEADER
if QFLG
QUIT
+19 ;149
IF '$GET(ECXPORT)
WRITE !,?5,WRDNM,?45,$$RJ^XLFSTR(WRDTOT,5," ")
+20 ;149
IF $GET(ECXPORT)
SET ^TMP($JOB,"ECXPORT",RCNT)=ECXEXT_U_DIVNM_U_ECXARRAY("START")_" to "_ECXARRAY("END")_U_WRDNM_U_WRDTOT
SET RCNT=RCNT+1
+21 ;if data1 exists, then this is the end of a ward group so print group total
+22 IF $GET(DATA1)
Begin DoDot:3
+23 SET GRPNM=$PIECE(DATA1,U,2)
SET GRPTOT=$PIECE(DATA1,U,3)
+24 ;149
IF $GET(ECXPORT)
SET ^TMP($JOB,"ECXPORT",RCNT)="^^Ward group "_GRPNM_" subtotal:"_U_GRPTOT
SET RCNT=RCNT+1
SET ^TMP($JOB,"ECXPORT",RCNT)="^"
SET RCNT=RCNT+1
QUIT
+25 if ($Y+3>IOSL)
DO HEADER
if QFLG
QUIT
+26 WRITE !,?40,"----------"
+27 WRITE !,"Ward group "_GRPNM_" subtotal:",?45,$$RJ^XLFSTR(GRPTOT,5," ")
+28 if ($Y+3>IOSL)
DO HEADER
if QFLG
QUIT
+29 WRITE !!
End DoDot:3
if QFLG
QUIT
End DoDot:2
if QFLG
QUIT
+30 ;149
IF '$GET(ECXPORT)
if ($Y+3>IOSL)
DO HEADER
if QFLG
QUIT
+31 ;149
IF $GET(ECXPORT)
SET ^TMP($JOB,"ECXPORT",RCNT)="^^Division "_$PIECE(ECXDIV(DIV),U,2)_U_"Grand Total:"_U_GTOT(DIV)
SET RCNT=RCNT+1
SET ^TMP($JOB,"ECXPORT",RCNT)="^"
SET RCNT=RCNT+1
QUIT
+32 WRITE !!,"Division "_$PIECE(ECXDIV(DIV),U,2)_" Grand Total:",?45,$$RJ^XLFSTR(GTOT(DIV),5," ")
End DoDot:1
if QFLG
QUIT
+33 ;print patients with missing wards or missing treating specialties
+34 ;149 Stop if user entered "^"
if QFLG
QUIT
+35 ;174 Has note printed? (0-no, 1- yes)
SET NOTE=0
+36 ;170,173
FOR MISTYPE="MISWRD","MISTRT","ASIH"
if QFLG
QUIT
IF $DATA(^TMP($JOB,MISTYPE))
Begin DoDot:1
+37 ;149,170,173
SET DIV=MISTYPE
SET ECXDIV(DIV)="^^^^^*** "_$SELECT(MISTYPE="MISWRD":"MISSING WARDS",MISTYPE="ASIH":"ASIH OTHER FACILITY",1:"MISSING TREATING SPECIALTIES")_" ***^"
if '$GET(ECXPORT)
DO HEADER
if QFLG
QUIT
+38 ;170
SET WRDTOT=$GET(^TMP($JOB,MISTYPE))
+39 ;149,170,173
IF '$GET(ECXPORT)
Begin DoDot:2
+40 ;149,170,173
WRITE !,?5,$SELECT(MISTYPE="MISWRD":"MISSING WARD",MISTYPE="ASIH":"ASIH OTHER FACILITY",1:"MISSING TREATING SPECIALTY"),?45,$$RJ^XLFSTR(WRDTOT,5," "),!!
+41 ;173,174
IF 'NOTE
Begin DoDot:3
+42 ;173,174
WRITE "NOTE: Records are generated in the extract for ASIH Other Facility"
+43 WRITE !,"movement types. If present in your facility, this report will display"
+44 ;173,174
WRITE !,"them. Missing Wards and Treating Specialties for ASIH Other Facility",!
+45 ;174
WRITE "patients REQUIRE NO ACTION because the patient is at another facility.",!!
End DoDot:3
SET NOTE=1
End DoDot:2
+46 ;149,170
IF $GET(ECXPORT)
Begin DoDot:2
+47 ;170,173
SET ^TMP($JOB,"ECXPORT",RCNT)="^"
SET RCNT=RCNT+1
SET ^TMP($JOB,"ECXPORT",RCNT)="^^"_$SELECT(MISTYPE="MISWRD":"MISSING WARD",MISTYPE="ASIH":"ASIH OTHER FACILITY",1:"MISSING TREATING SPECIALTY")_U_WRDTOT
+48 ;173,174
IF 'NOTE
Begin DoDot:3
+49 ;173
SET RCNT=RCNT+1
+50 ;173,174
SET ^TMP($JOB,"ECXPORT",RCNT)="^"
SET RCNT=RCNT+1
SET ^TMP($JOB,"ECXPORT",RCNT)="^NOTE: Records are generated in the extract for ASIH Other Facility Movement types."
SET RCNT=RCNT+1
+51 ;173,174
SET ^TMP($JOB,"ECXPORT",RCNT)="^If present in your facility, this report will display them. Missing wards"
SET RCNT=RCNT+1
+52 ;173,174
SET ^TMP($JOB,"ECXPORT",RCNT)="^and Treating Specialties for ASIH Other Facility patients REQUIRE NO ACTION because"
+53 ;174
SET RCNT=RCNT+1
SET ^TMP($JOB,"ECXPORT",RCNT)="^the patient is at another facility."
End DoDot:3
SET NOTE=1
+54 ;170,173
SET RCNT=RCNT+1
SET ^TMP($JOB,"ECXPORT",RCNT)="^"
SET RCNT=RCNT+1
SET ^TMP($JOB,"ECXPORT",RCNT)="^NAME^PATIENT DFN^FACILITY^ADMISSION DATE^ASIH OTHER FACILITY"
SET RCNT=RCNT+1
End DoDot:2
+55 ;149
IF '$GET(ECXPORT)
DO HEAD
+56 ;170
SET IEN=""
FOR
SET IEN=$ORDER(^TMP($JOB,MISTYPE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+57 SET DATA=$GET(^ECX(727.802,IEN,0))
SET ADMDT=$PIECE(DATA,U,9)
if DATA=""
QUIT
+58 ;173
SET FAC=$PIECE(DATA,U,4)
if FAC'=""
SET FAC=$$GET1^DIQ(40.8,FAC,.01,"E")
+59 ;149,173
IF $GET(ECXPORT)
SET ^TMP($JOB,"ECXPORT",RCNT)="^"_$PIECE(DATA,U,7)_U_$PIECE(DATA,U,5)_U_FAC_U_$EXTRACT(ADMDT,5,6)_"/"_$EXTRACT(ADMDT,7,8)_"/"_$EXTRACT(ADMDT,1,4)_" "_$EXTRACT($PIECE(DATA,U,34),1,2)_":"_$EXTRACT($PIECE(DATA,U,34),3,4)_U_.
..
... $SELECT($PIECE(DATA,U,8)="A":"YES",1:"NO")
SET RCNT=RCNT+1
QUIT
+60 WRITE !?2,$PIECE(DATA,U,7),?8,$PIECE(DATA,U,5),?25,$EXTRACT(FAC,1,14),?45
+61 WRITE $EXTRACT(ADMDT,5,6)_"/"_$EXTRACT(ADMDT,7,8)_"/"_$EXTRACT(ADMDT,1,4)," "
+62 WRITE $EXTRACT($PIECE(DATA,U,34),1,2)_":"_$EXTRACT($PIECE(DATA,U,34),3,4)
+63 ;173
WRITE ?63,$SELECT($PIECE(DATA,U,8)="A":"YES",1:"NO")
+64 if ($Y+3>IOSL)
DO HEADER
DO HEAD
if QFLG
QUIT
End DoDot:2
IF QFLG
QUIT
End DoDot:1
+65 ;149
IF $GET(ECXPORT)
QUIT
+66 IF $EXTRACT(IOST)'="C"
Begin DoDot:1
+67 WRITE @IOF
SET PG=PG+1
+68 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
+69 WRITE !,"DSS Extract Log #: "_ECXEXT
+70 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
+71 WRITE !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG
+72 WRITE !!,LN,!!
+73 SET DIC="^ECX(727.1,"
SET DA=ECXARRAY("DEF")
SET DR="1"
DO EN^DIQ
+74 WRITE @IOF
End DoDot:1
+75 IF $EXTRACT(IOST)="C"
IF 'QFLG
Begin DoDot:1
+76 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+77 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
+78 QUIT
+79 ;
HEAD ;173 header for missing wards, treating specialties, and ASIH OTHER FACILITY
+1 ;173
WRITE !,?2,"NAME",?8,"PATIENT DFN",?25,"FACILITY",?45,"ADMISSION DATE",?63,"ASIH OTHER FAC"
+2 ;173
WRITE !,?2,"====",?8,"===========",?25,"========",?45,"==============",?63,"=============="
+3 QUIT
+4 ;
+1 NEW JJ,SS,DIR,DIRUT,DTOUT,DUOUT,DSSID
+2 ;149 Stop if user entered "^"
IF $EXTRACT(IOST)="C"
IF 'QFLG
Begin DoDot:1
+3 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+4 IF PG>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
if 'Y
SET QFLG=1
End DoDot:1
+5 if QFLG
QUIT
+6 SET DSSID=$PIECE(ECXDIV(DIV),U,6)
+7 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
SET PG=PG+1
+8 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
+9 WRITE !,"DSS Extract Log #: "_ECXEXT
+10 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
+11 WRITE !,"Report Run Date/Time: "_ECXRUN
+12 IF DSSID=""
WRITE !,"Medical Center Division: "_$PIECE(ECXDIV(DIV),U,2)_" ("_$PIECE(ECXDIV(DIV),U,3)_")",?68,"Page: "_PG
+13 IF DSSID]""
WRITE !,"Medical Center Division: "_$PIECE(ECXDIV(DIV),U,2)_" ("_$PIECE(ECXDIV(DIV),U,3)_")"_" <"_DSSID_">",?68,"Page: "_PG
+14 WRITE !!,?5,"Ward <DSS Dept.>",?40,"# of Admissions"
+15 WRITE !,LN,!
+16 QUIT
