DGMSTR3 ;ALB/GRR - GENERATE AND PRINT MST STATISTICAL REPORT ;1/30/01 10:45am
;;5.3;Registration;**195,319,850**; Aug 13, 1993;Build 171
;^TMP("DGMSTR3,JOB... - Array to hold ICD codes
;DGPCDT - Current date in print format
;DGSDAT - Start Date of selection range
;DGEDAT - End Date of selection range
;DGDX - ICD Code
;DGDLOS - Length of Stay
;DGPDAYS - Pass days
;DGMST("N") - Number of new cases of MST
;DGMST("O","R") - Number of outpatient visits related to MST
;DGMST("O","NR") - Number of outpatient visits not related to MST
;DGMST("O","U") - Number of unique outpatients treated for MST
;DGMST("O","AR") - Average number of outpatient visits related to MST
;DGMST("O","ANR") - Average number of outpatient visits not related to MST
;DGMST("I", - Same totals as above except for inpatient
;DGMST("LOS") - Total Length of Stay related to MST
EN ;ENTRY POINT FOR ROUTINE
N TJOB
S TJOB=$J
K ^TMP("DGMSTR3",$J)
N DGMST,DGPCDT,DGSUB,DGSTAT,DGPSDT,DGPEDT,DTOUT,DUOUT,ZTSAVE,X,Y
N DTOUT,DUOUT,ZTSAVE,DGLABEL,EFFDATE,IMPDATE,DGTEMP,VA,VAERR,DGPTDAT
K DGMST
D DT^DICRW
S Y=DT D DD^%DT S DGPCDT=Y
F DGSTAT="O","I" F DGSUB="R","NR","U","AR","ANR","T" S DGMST(DGSTAT,DGSUB)=0
S DGMST("N")=0,DGMST("LOS")=0,DGMST("ALOS")=0
;GET DATE RANGE
S DGTEMP=$$IMPDATE^DGPTIC10("10D"),IMPDATE=+DGTEMP
SDAT S DIR(0)="D^:"_DT_":EXP",DIR("A")="Start Date"
D ^DIR K DIR
Q:$D(DTOUT)!($D(DUOUT))
S DGSDAT=+Y,Y=+Y D DD^%DT S DGPSDT=Y
TDAT ;
S DIR(0)="D^"_DGSDAT_":"_DT_":EXP",DIR("A")="End Date"
I DGSDAT<IMPDATE,DT'<IMPDATE D
. W !!,?10,"Start date is before ICD-10 implementation.",!,?10,"End date must be before ICD-10 implementation",!
. S DIR(0)="D^"_DGSDAT_":"_$$FMADD^XLFDT(IMPDATE,-1)_":EXP"
D ^DIR K DIR
Q:$D(DTOUT)!($D(DUOUT))
S DGEDAT=+Y_.9999,Y=+Y D DD^%DT S DGPEDT=Y
DEVICE F X="DGMST(","DGSDAT","DGPSDT","DGEDAT","DGPEDT","DGPCDT" S ZTSAVE(X)=""
W !!,"This may take long to print, queue the report to free-up your terminal!",!
D EN^XUTMDEVQ("RPT^DGMSTR3","MST Statistical Summary",.ZTSAVE)
D HOME^%ZIS
Q
RPT ;LOOP THROUGH AND CALCULATE NEW MST CASES
N DFN,SEX,DGSEDT,DGDATE,DGEIEN,DGAPST,DGCALC,DGTYP,DGGEN,DGIEN,DA,X,Y,DTOUT,DUOUT,VADM
N DGCSTAT,DGDA,DGCC,DGCLIEN,DGDX,DGMIEN,DGPTFIEN,DGLOS,DGPDAYS
N DGDXERR,DGLOS,DGOCIEN
S DGDATE=DGSDAT F S DGDATE=$O(^DGMS(29.11,"B",DGDATE)) Q:DGDATE'>0!(DGDATE>DGEDAT) S DGIEN=0 F S DGIEN=$O(^DGMS(29.11,"B",DGDATE,DGIEN)) Q:DGIEN'>0 S:$P($G(^DGMS(29.11,DGIEN,0)),"^",3)="Y" DGMST("N")=DGMST("N")+1
;GET IEN FOR MST CLASSIFICATION TYPE
S DIC=409.41,DIC(0)="X",X="MILITARY SEXUAL TRAUMA"
D ^DIC K DIC
I Y'>0 W !!,"Military Sexual Trauma entry missing from Outpatient Classification Type (409.41) file" Q
S DGOCIEN=+Y K DFN S DFN=""
;CALCULATE OUTPATIENT TOTALS
S DGDATE=DGSDAT F S DGDATE=$O(^SCE("B",DGDATE)) Q:DGDATE'>0!(DGDATE>DGEDAT) D
.S DGEIEN=0 F S DGEIEN=$O(^SCE("B",DGDATE,DGEIEN)) Q:DGEIEN'>0 D
..S Y(0)=$G(^SCE(DGEIEN,0)) Q:Y(0)=""
..S DFN=$P(Y(0),"^",2),DGAPST=$P(Y(0),"^",12) Q:DGAPST=8 ;DGAPST=8 MEANS INPATIENT, DONT COUNT
..I DFN="" Q
..S DGCSTAT=$$GETSTAT^DGMSTAPI(DFN,DGEDAT)
..S DGCC=$P(DGCSTAT,"^",2)
..I DGCC'="Y"&(DGCC'="N")&(DGCC'="D")&(DGCC'="U") Q
..S DGCLIEN=$O(^SDD(409.42,"AO",DGEIEN,DGOCIEN,0)),DGMST("O","T")=DGMST("O","T")+1 I DGCLIEN]"" D
...I $P($G(^SDD(409.42,DGCLIEN,0)),"^",3)'=1 S DGMST("O","NR")=DGMST("O","NR")+1
...E S DGMST("O","R")=DGMST("O","R")+1 I '$D(DFN(DFN,"O")) S DFN(DFN,"O")="",DGMST("O","U")=DGMST("O","U")+1
..D DEM^VADPT S SEX=$P(VADM(5),"^")
..I SEX="M"!(SEX="F") D
...S DGDX=$$GETPDX^SDOE(DGEIEN,.DGDXERR) ;; CHANGED 4.16.99 SCK CORRECT FOR API
...I DGDX'="",+DGDX>0 S DGTEMP=$$ICDDATA^ICDXCODE("DIAG",DGDX,DGDATE),DGDX=$P(DGTEMP,"^",2) I DGDX'=""!(+DGTEMP'<1) D
....I DGDX["Invalid Code " Q
....I '$D(^TMP("DGMSTR3",$J,DGDX)) F DGGEN="M","F" F DGTYP="I","O" S ^TMP("DGMSTR3",$J,DGDX,DGGEN,DGTYP)=0
....S ^TMP("DGMSTR3",$J,DGDX,SEX,"O")=^TMP("DGMSTR3",$J,DGDX,SEX,"O")+1
;LOOP FOR INPATIENT CALCULATIONS
S DGDATE=DGSDAT F S DGDATE=$O(^DGPM("B",DGDATE)) Q:DGDATE'>0!(DGDATE>DGEDAT) S DGDA=0 F S DGDA=$O(^DGPM("B",DGDATE,DGDA)) Q:DGDA'>0 S DGPTFIEN=$P($G(^DGPM(DGDA,0)),"^",16) I DGPTFIEN'="" D
.D EFFDATE^DGPTIC10(DGPTFIEN)
.S DGMIEN=0,DGPDAYS=0,DGCALC=0 F S DGMIEN=$O(^DGPT(DGPTFIEN,"M",DGMIEN)) Q:DGMIEN'>0 D
..S Y(0)=$G(^(DGMIEN,0)),DGPDAYS=DGPDAYS+(+$P(Y(0),"^",4)),DGMST("I","T")=DGMST("I","T")+1
..I $P(Y(0),"^",29)="Y" D
...S DGMST("I","R")=DGMST("I","R")+1,DGCALC=1
...S DFN=$P(^DGPT(DGPTFIEN,0),"^")
...Q:DFN=""
...I '$D(DFN(DFN,"I")) S DFN(DFN,"I")="",DGMST("I","U")=DGMST("I","U")+1
...S DGDX=$P(Y(0),"^",5) D DEM^VADPT S SEX=$P(VADM(5),"^")
...I DGDX'="",+DGDX>0,SEX="M"!(SEX="F") S DGTEMP=$$ICDDATA^ICDXCODE("DIAG",DGDX,EFFDATE),DGDX=$P(DGTEMP,"^",2) I DGDX'=""!(+DGTEMP'<1) D
....I DGDX["Invalid Code " Q
....I '$D(^TMP("DGMSTR3",$J,DGDX)) F DGGEN="M","F" F DGTYP="I","O" S ^TMP("DGMSTR3",$J,DGDX,DGGEN,DGTYP)=0
....S ^TMP("DGMSTR3",$J,DGDX,SEX,"I")=^TMP("DGMSTR3",$J,DGDX,SEX,"I")+1
..E S DGMST("I","NR")=DGMST("I","NR")+1
.I +$G(DGCALC)>0,$P($G(^DGPT(DGPTFIEN,70)),"^")]"" D
..S DGLOS=$$CALCLOS(DGPTFIEN,DGPDAYS),DGMST("LOS")=DGMST("LOS")+DGLOS
PRT ;LAST CALCULATIONS AND PRINT
I DGMST("LOS")>0 S DGMST("ALOS")=DGMST("LOS")/DGMST("I","R")
I DGMST("O","T")>0 S DGMST("O","AR")=$J(DGMST("O","R")/DGMST("O","T"),7,2),DGMST("O","ANR")=$J(DGMST("O","NR")/DGMST("O","T"),7,2)
I DGMST("I","T")>0 S DGMST("I","AR")=$J(DGMST("I","R")/DGMST("I","T"),7,2),DGMST("I","ANR")=$J(DGMST("I","NR")/DGMST("I","T"),7,2)
D NOFF
W !!,"# OF NEW CASES IDENTIFIED FOR MST",?78-$L(DGMST("N")),DGMST("N")
W !!,"-------------OUTPATIENT STATISTICS-------------"
W !!,"# OF OUTPATIENT ENCOUNTERS RELATED TO MST",?78-$L(DGMST("O","R")),DGMST("O","R")
W !,"# OF OUTPATIENT ENCOUNTERS NOT RELATED TO MST",?78-$L(DGMST("O","NR")),DGMST("O","NR")
W !,"# OF UNIQUE OUTPATIENTS TREATED FOR MST",?78-$L(DGMST("O","U")),DGMST("O","U")
W !,"AVERAGE # OF ENCOUNTERS RELATED TO MST",?78-$L(DGMST("O","AR")),DGMST("O","AR")
W !,"AVERAGE # OF ENCOUNTERS NOT RELATED TO MST",?78-$L(DGMST("O","ANR")),DGMST("O","ANR")
W !!,"-------------INPATIENT STATISTICS---------------"
W !!,"# OF INPATIENT EPISODES RELATED TO MST",?78-$L(DGMST("I","R")),DGMST("I","R")
W !,"# OF INPATIENT EPISODES NOT RELATED TO MST",?78-$L(DGMST("I","NR")),DGMST("I","NR")
W !,"# OF UNIQUE INPATIENTS TREATED FOR MST",?78-$L(DGMST("I","U")),DGMST("I","U")
W !,"AVERAGE # OF INPATIENT EPISODES TREATED FOR MST",?78-$L(DGMST("I","AR")),DGMST("I","AR")
W !,"AVERAGE # OF INPATIENT EPISODES NOT TREATED FOR MST",?78-$L(DGMST("I","ANR")),DGMST("I","ANR")
W !,"TOTAL LENGTH OF STAY OF INPATIENTS TREATED FOR MST",?78-$L(DGMST("LOS")),DGMST("LOS")
W !,"AVERAGE LENGTH OF STAY OF INPATIENTS TREATED FOR MST",?78-$L(DGMST("ALOS")),DGMST("ALOS")
I $Y+3>$G(IOSL) D Q:$D(DTOUT)!($D(DUOUT))
.I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR Q:$D(DTOUT)!($D(DUOUT))
.D HED
G:$O(^TMP("DGMSTR3",$J,0))="" END1 ;;CHANGED BY SCK 4.16.99 CHECK ON ERROR
S DGLABEL=" ICD"
W !!,DGLABEL,?24,"NUMBER OF MALE",?54,"NUMBER OF FEMALE"
W !,?22,"OUTPATIENT",?35,"INPATIENT",?52,"OUTPATIENT",?65,"INPATIENT"
S DGDX="" F S DGDX=$O(^TMP("DGMSTR3",$J,DGDX)) Q:DGDX="" D Q:$D(DTOUT)!($D(DUOUT))
.I $Y+3>IOSL D Q:$D(DTOUT)!($D(DUOUT))
..I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR Q:$D(DTOUT)!($D(DUOUT))
..D HED W !!,DGLABEL,?24,"NUMBER OF MALE",?54,"NUMBER OF FEMALE",!,?22,"OUTPATIENT",?35,"INPATIENT",?52,"OUTPATIENT",?65,"INPATIENT"
.W !,?2,DGDX,?28-$L(^TMP("DGMSTR3",$J,DGDX,"M","O"))
.W ^TMP("DGMSTR3",$J,DGDX,"M","O")
.W ?40-$L(^TMP("DGMSTR3",$J,DGDX,"M","I"))
.W ^TMP("DGMSTR3",$J,DGDX,"M","I")
.W ?58-$L(^TMP("DGMSTR3",$J,DGDX,"F","O")),^TMP("DGMSTR3",$J,DGDX,"F","O")
.W ?70-$L(^TMP("DGMSTR3",$J,DGDX,"F","I"))
.W ^TMP("DGMSTR3",$J,DGDX,"F","I")
I $E(IOST,1,2)="C-" S DIR="E" D ^DIR K DIR
END1 K DA,DGSDAT,DGEDAT,DGMST,DGPCDT,DGPEDT,DGPSDT,X,Y
K ^TMP("DGMSTAPI",$J)
K TJOB
Q
;
CALCLOS(DGPTFIEN,DGPDAYS) ;CALCULATE LOS FOR EPISODE
N DGADT,DGDDT,DGLDAYS,DGDAYS,Y,X1,X2
S Y(70)=$G(^DGPT(DGPTFIEN,70)) Q:Y(70)="" 0
S DGDDT=$P(Y(70),"^")\1,DGADT=$P(^DGPT(DGPTFIEN,0),"^",2)\1,DGLDAYS=$P(Y(70),"^",8)
S X1=DGDDT,X2=DGADT D ^%DTC
S DGDAYS=X-(DGLDAYS+DGPDAYS)
Q DGDAYS
;
HED ;PRINT HEADER INFO
W @IOF
NOFF W !,?20,"MST Statistical Report"
W !,?20,"Date Range: ",DGPSDT," - ",DGPEDT
W !,?20,"Date Report Printed: ",DGPCDT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMSTR3 8540 printed Nov 22, 2024@17:54:29 Page 2
DGMSTR3 ;ALB/GRR - GENERATE AND PRINT MST STATISTICAL REPORT ;1/30/01 10:45am
+1 ;;5.3;Registration;**195,319,850**; Aug 13, 1993;Build 171
+2 ;^TMP("DGMSTR3,JOB... - Array to hold ICD codes
+3 ;DGPCDT - Current date in print format
+4 ;DGSDAT - Start Date of selection range
+5 ;DGEDAT - End Date of selection range
+6 ;DGDX - ICD Code
+7 ;DGDLOS - Length of Stay
+8 ;DGPDAYS - Pass days
+9 ;DGMST("N") - Number of new cases of MST
+10 ;DGMST("O","R") - Number of outpatient visits related to MST
+11 ;DGMST("O","NR") - Number of outpatient visits not related to MST
+12 ;DGMST("O","U") - Number of unique outpatients treated for MST
+13 ;DGMST("O","AR") - Average number of outpatient visits related to MST
+14 ;DGMST("O","ANR") - Average number of outpatient visits not related to MST
+15 ;DGMST("I", - Same totals as above except for inpatient
+16 ;DGMST("LOS") - Total Length of Stay related to MST
EN ;ENTRY POINT FOR ROUTINE
+1 NEW TJOB
+2 SET TJOB=$JOB
+3 KILL ^TMP("DGMSTR3",$JOB)
+4 NEW DGMST,DGPCDT,DGSUB,DGSTAT,DGPSDT,DGPEDT,DTOUT,DUOUT,ZTSAVE,X,Y
+5 NEW DTOUT,DUOUT,ZTSAVE,DGLABEL,EFFDATE,IMPDATE,DGTEMP,VA,VAERR,DGPTDAT
+6 KILL DGMST
+7 DO DT^DICRW
+8 SET Y=DT
DO DD^%DT
SET DGPCDT=Y
+9 FOR DGSTAT="O","I"
FOR DGSUB="R","NR","U","AR","ANR","T"
SET DGMST(DGSTAT,DGSUB)=0
+10 SET DGMST("N")=0
SET DGMST("LOS")=0
SET DGMST("ALOS")=0
+11 ;GET DATE RANGE
+12 SET DGTEMP=$$IMPDATE^DGPTIC10("10D")
SET IMPDATE=+DGTEMP
SDAT SET DIR(0)="D^:"_DT_":EXP"
SET DIR("A")="Start Date"
+1 DO ^DIR
KILL DIR
+2 if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+3 SET DGSDAT=+Y
SET Y=+Y
DO DD^%DT
SET DGPSDT=Y
TDAT ;
+1 SET DIR(0)="D^"_DGSDAT_":"_DT_":EXP"
SET DIR("A")="End Date"
+2 IF DGSDAT<IMPDATE
IF DT'<IMPDATE
Begin DoDot:1
+3 WRITE !!,?10,"Start date is before ICD-10 implementation.",!,?10,"End date must be before ICD-10 implementation",!
+4 SET DIR(0)="D^"_DGSDAT_":"_$$FMADD^XLFDT(IMPDATE,-1)_":EXP"
End DoDot:1
+5 DO ^DIR
KILL DIR
+6 if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+7 SET DGEDAT=+Y_.9999
SET Y=+Y
DO DD^%DT
SET DGPEDT=Y
DEVICE FOR X="DGMST(","DGSDAT","DGPSDT","DGEDAT","DGPEDT","DGPCDT"
SET ZTSAVE(X)=""
+1 WRITE !!,"This may take long to print, queue the report to free-up your terminal!",!
+2 DO EN^XUTMDEVQ("RPT^DGMSTR3","MST Statistical Summary",.ZTSAVE)
+3 DO HOME^%ZIS
+4 QUIT
RPT ;LOOP THROUGH AND CALCULATE NEW MST CASES
+1 NEW DFN,SEX,DGSEDT,DGDATE,DGEIEN,DGAPST,DGCALC,DGTYP,DGGEN,DGIEN,DA,X,Y,DTOUT,DUOUT,VADM
+2 NEW DGCSTAT,DGDA,DGCC,DGCLIEN,DGDX,DGMIEN,DGPTFIEN,DGLOS,DGPDAYS
+3 NEW DGDXERR,DGLOS,DGOCIEN
+4 SET DGDATE=DGSDAT
FOR
SET DGDATE=$ORDER(^DGMS(29.11,"B",DGDATE))
if DGDATE'>0!(DGDATE>DGEDAT)
QUIT
SET DGIEN=0
FOR
SET DGIEN=$ORDER(^DGMS(29.11,"B",DGDATE,DGIEN))
if DGIEN'>0
QUIT
if $PIECE($GET(^DGMS(29.11,DGIEN,0)),"^",3)="Y"
SET DGMST("N")=DGMST("N")+1
+5 ;GET IEN FOR MST CLASSIFICATION TYPE
+6 SET DIC=409.41
SET DIC(0)="X"
SET X="MILITARY SEXUAL TRAUMA"
+7 DO ^DIC
KILL DIC
+8 IF Y'>0
WRITE !!,"Military Sexual Trauma entry missing from Outpatient Classification Type (409.41) file"
QUIT
+9 SET DGOCIEN=+Y
KILL DFN
SET DFN=""
+10 ;CALCULATE OUTPATIENT TOTALS
+11 SET DGDATE=DGSDAT
FOR
SET DGDATE=$ORDER(^SCE("B",DGDATE))
if DGDATE'>0!(DGDATE>DGEDAT)
QUIT
Begin DoDot:1
+12 SET DGEIEN=0
FOR
SET DGEIEN=$ORDER(^SCE("B",DGDATE,DGEIEN))
if DGEIEN'>0
QUIT
Begin DoDot:2
+13 SET Y(0)=$GET(^SCE(DGEIEN,0))
if Y(0)=""
QUIT
+14 ;DGAPST=8 MEANS INPATIENT, DONT COUNT
SET DFN=$PIECE(Y(0),"^",2)
SET DGAPST=$PIECE(Y(0),"^",12)
if DGAPST=8
QUIT
+15 IF DFN=""
QUIT
+16 SET DGCSTAT=$$GETSTAT^DGMSTAPI(DFN,DGEDAT)
+17 SET DGCC=$PIECE(DGCSTAT,"^",2)
+18 IF DGCC'="Y"&(DGCC'="N")&(DGCC'="D")&(DGCC'="U")
QUIT
+19 SET DGCLIEN=$ORDER(^SDD(409.42,"AO",DGEIEN,DGOCIEN,0))
SET DGMST("O","T")=DGMST("O","T")+1
IF DGCLIEN]""
Begin DoDot:3
+20 IF $PIECE($GET(^SDD(409.42,DGCLIEN,0)),"^",3)'=1
SET DGMST("O","NR")=DGMST("O","NR")+1
+21 IF '$TEST
SET DGMST("O","R")=DGMST("O","R")+1
IF '$DATA(DFN(DFN,"O"))
SET DFN(DFN,"O")=""
SET DGMST("O","U")=DGMST("O","U")+1
End DoDot:3
+22 DO DEM^VADPT
SET SEX=$PIECE(VADM(5),"^")
+23 IF SEX="M"!(SEX="F")
Begin DoDot:3
+24 ;; CHANGED 4.16.99 SCK CORRECT FOR API
SET DGDX=$$GETPDX^SDOE(DGEIEN,.DGDXERR)
+25 IF DGDX'=""
IF +DGDX>0
SET DGTEMP=$$ICDDATA^ICDXCODE("DIAG",DGDX,DGDATE)
SET DGDX=$PIECE(DGTEMP,"^",2)
IF DGDX'=""!(+DGTEMP'<1)
Begin DoDot:4
+26 IF DGDX["Invalid Code "
QUIT
+27 IF '$DATA(^TMP("DGMSTR3",$JOB,DGDX))
FOR DGGEN="M","F"
FOR DGTYP="I","O"
SET ^TMP("DGMSTR3",$JOB,DGDX,DGGEN,DGTYP)=0
+28 SET ^TMP("DGMSTR3",$JOB,DGDX,SEX,"O")=^TMP("DGMSTR3",$JOB,DGDX,SEX,"O")+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+29 ;LOOP FOR INPATIENT CALCULATIONS
+30 SET DGDATE=DGSDAT
FOR
SET DGDATE=$ORDER(^DGPM("B",DGDATE))
if DGDATE'>0!(DGDATE>DGEDAT)
QUIT
SET DGDA=0
FOR
SET DGDA=$ORDER(^DGPM("B",DGDATE,DGDA))
if DGDA'>0
QUIT
SET DGPTFIEN=$PIECE($GET(^DGPM(DGDA,0)),"^",16)
IF DGPTFIEN'=""
Begin DoDot:1
+31 DO EFFDATE^DGPTIC10(DGPTFIEN)
+32 SET DGMIEN=0
SET DGPDAYS=0
SET DGCALC=0
FOR
SET DGMIEN=$ORDER(^DGPT(DGPTFIEN,"M",DGMIEN))
if DGMIEN'>0
QUIT
Begin DoDot:2
+33 SET Y(0)=$GET(^(DGMIEN,0))
SET DGPDAYS=DGPDAYS+(+$PIECE(Y(0),"^",4))
SET DGMST("I","T")=DGMST("I","T")+1
+34 IF $PIECE(Y(0),"^",29)="Y"
Begin DoDot:3
+35 SET DGMST("I","R")=DGMST("I","R")+1
SET DGCALC=1
+36 SET DFN=$PIECE(^DGPT(DGPTFIEN,0),"^")
+37 if DFN=""
QUIT
+38 IF '$DATA(DFN(DFN,"I"))
SET DFN(DFN,"I")=""
SET DGMST("I","U")=DGMST("I","U")+1
+39 SET DGDX=$PIECE(Y(0),"^",5)
DO DEM^VADPT
SET SEX=$PIECE(VADM(5),"^")
+40 IF DGDX'=""
IF +DGDX>0
IF SEX="M"!(SEX="F")
SET DGTEMP=$$ICDDATA^ICDXCODE("DIAG",DGDX,EFFDATE)
SET DGDX=$PIECE(DGTEMP,"^",2)
IF DGDX'=""!(+DGTEMP'<1)
Begin DoDot:4
+41 IF DGDX["Invalid Code "
QUIT
+42 IF '$DATA(^TMP("DGMSTR3",$JOB,DGDX))
FOR DGGEN="M","F"
FOR DGTYP="I","O"
SET ^TMP("DGMSTR3",$JOB,DGDX,DGGEN,DGTYP)=0
+43 SET ^TMP("DGMSTR3",$JOB,DGDX,SEX,"I")=^TMP("DGMSTR3",$JOB,DGDX,SEX,"I")+1
End DoDot:4
End DoDot:3
+44 IF '$TEST
SET DGMST("I","NR")=DGMST("I","NR")+1
End DoDot:2
+45 IF +$GET(DGCALC)>0
IF $PIECE($GET(^DGPT(DGPTFIEN,70)),"^")]""
Begin DoDot:2
+46 SET DGLOS=$$CALCLOS(DGPTFIEN,DGPDAYS)
SET DGMST("LOS")=DGMST("LOS")+DGLOS
End DoDot:2
End DoDot:1
PRT ;LAST CALCULATIONS AND PRINT
+1 IF DGMST("LOS")>0
SET DGMST("ALOS")=DGMST("LOS")/DGMST("I","R")
+2 IF DGMST("O","T")>0
SET DGMST("O","AR")=$JUSTIFY(DGMST("O","R")/DGMST("O","T"),7,2)
SET DGMST("O","ANR")=$JUSTIFY(DGMST("O","NR")/DGMST("O","T"),7,2)
+3 IF DGMST("I","T")>0
SET DGMST("I","AR")=$JUSTIFY(DGMST("I","R")/DGMST("I","T"),7,2)
SET DGMST("I","ANR")=$JUSTIFY(DGMST("I","NR")/DGMST("I","T"),7,2)
+4 DO NOFF
+5 WRITE !!,"# OF NEW CASES IDENTIFIED FOR MST",?78-$LENGTH(DGMST("N")),DGMST("N")
+6 WRITE !!,"-------------OUTPATIENT STATISTICS-------------"
+7 WRITE !!,"# OF OUTPATIENT ENCOUNTERS RELATED TO MST",?78-$LENGTH(DGMST("O","R")),DGMST("O","R")
+8 WRITE !,"# OF OUTPATIENT ENCOUNTERS NOT RELATED TO MST",?78-$LENGTH(DGMST("O","NR")),DGMST("O","NR")
+9 WRITE !,"# OF UNIQUE OUTPATIENTS TREATED FOR MST",?78-$LENGTH(DGMST("O","U")),DGMST("O","U")
+10 WRITE !,"AVERAGE # OF ENCOUNTERS RELATED TO MST",?78-$LENGTH(DGMST("O","AR")),DGMST("O","AR")
+11 WRITE !,"AVERAGE # OF ENCOUNTERS NOT RELATED TO MST",?78-$LENGTH(DGMST("O","ANR")),DGMST("O","ANR")
+12 WRITE !!,"-------------INPATIENT STATISTICS---------------"
+13 WRITE !!,"# OF INPATIENT EPISODES RELATED TO MST",?78-$LENGTH(DGMST("I","R")),DGMST("I","R")
+14 WRITE !,"# OF INPATIENT EPISODES NOT RELATED TO MST",?78-$LENGTH(DGMST("I","NR")),DGMST("I","NR")
+15 WRITE !,"# OF UNIQUE INPATIENTS TREATED FOR MST",?78-$LENGTH(DGMST("I","U")),DGMST("I","U")
+16 WRITE !,"AVERAGE # OF INPATIENT EPISODES TREATED FOR MST",?78-$LENGTH(DGMST("I","AR")),DGMST("I","AR")
+17 WRITE !,"AVERAGE # OF INPATIENT EPISODES NOT TREATED FOR MST",?78-$LENGTH(DGMST("I","ANR")),DGMST("I","ANR")
+18 WRITE !,"TOTAL LENGTH OF STAY OF INPATIENTS TREATED FOR MST",?78-$LENGTH(DGMST("LOS")),DGMST("LOS")
+19 WRITE !,"AVERAGE LENGTH OF STAY OF INPATIENTS TREATED FOR MST",?78-$LENGTH(DGMST("ALOS")),DGMST("ALOS")
+20 IF $Y+3>$GET(IOSL)
Begin DoDot:1
+21 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+22 DO HED
End DoDot:1
if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+23 ;;CHANGED BY SCK 4.16.99 CHECK ON ERROR
if $ORDER(^TMP("DGMSTR3",$JOB,0))=""
GOTO END1
+24 SET DGLABEL=" ICD"
+25 WRITE !!,DGLABEL,?24,"NUMBER OF MALE",?54,"NUMBER OF FEMALE"
+26 WRITE !,?22,"OUTPATIENT",?35,"INPATIENT",?52,"OUTPATIENT",?65,"INPATIENT"
+27 SET DGDX=""
FOR
SET DGDX=$ORDER(^TMP("DGMSTR3",$JOB,DGDX))
if DGDX=""
QUIT
Begin DoDot:1
+28 IF $Y+3>IOSL
Begin DoDot:2
+29 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+30 DO HED
WRITE !!,DGLABEL,?24,"NUMBER OF MALE",?54,"NUMBER OF FEMALE",!,?22,"OUTPATIENT",?35,"INPATIENT",?52,"OUTPATIENT",?65,"INPATIENT"
End DoDot:2
if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+31 WRITE !,?2,DGDX,?28-$LENGTH(^TMP("DGMSTR3",$JOB,DGDX,"M","O"))
+32 WRITE ^TMP("DGMSTR3",$JOB,DGDX,"M","O")
+33 WRITE ?40-$LENGTH(^TMP("DGMSTR3",$JOB,DGDX,"M","I"))
+34 WRITE ^TMP("DGMSTR3",$JOB,DGDX,"M","I")
+35 WRITE ?58-$LENGTH(^TMP("DGMSTR3",$JOB,DGDX,"F","O")),^TMP("DGMSTR3",$JOB,DGDX,"F","O")
+36 WRITE ?70-$LENGTH(^TMP("DGMSTR3",$JOB,DGDX,"F","I"))
+37 WRITE ^TMP("DGMSTR3",$JOB,DGDX,"F","I")
End DoDot:1
if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+38 IF $EXTRACT(IOST,1,2)="C-"
SET DIR="E"
DO ^DIR
KILL DIR
END1 KILL DA,DGSDAT,DGEDAT,DGMST,DGPCDT,DGPEDT,DGPSDT,X,Y
+1 KILL ^TMP("DGMSTAPI",$JOB)
+2 KILL TJOB
+3 QUIT
+4 ;
CALCLOS(DGPTFIEN,DGPDAYS) ;CALCULATE LOS FOR EPISODE
+1 NEW DGADT,DGDDT,DGLDAYS,DGDAYS,Y,X1,X2
+2 SET Y(70)=$GET(^DGPT(DGPTFIEN,70))
if Y(70)=""
QUIT 0
+3 SET DGDDT=$PIECE(Y(70),"^")\1
SET DGADT=$PIECE(^DGPT(DGPTFIEN,0),"^",2)\1
SET DGLDAYS=$PIECE(Y(70),"^",8)
+4 SET X1=DGDDT
SET X2=DGADT
DO ^%DTC
+5 SET DGDAYS=X-(DGLDAYS+DGPDAYS)
+6 QUIT DGDAYS
+7 ;
HED ;PRINT HEADER INFO
+1 WRITE @IOF
NOFF WRITE !,?20,"MST Statistical Report"
+1 WRITE !,?20,"Date Range: ",DGPSDT," - ",DGPEDT
+2 WRITE !,?20,"Date Report Printed: ",DGPCDT
+3 QUIT
+4 ;
