source: WorldVistAEHR/trunk/r/SURGERY-SR/SROQ2.m@ 691

SROQ2 ;BIR/ADM - SUMMARY REPORT ;07/18/07

 ;;3.0; Surgery ;**38,62,70,50,95,123,129,134,153,160,163**;24 Jun 93;Build 2

 ;** NOTICE: This routine is part of an implementation of a nationally

 ;**         controlled procedure. Local modifications to this routine

 ;**         are prohibited.

 ;

 S SRSOUT=0 W @IOF,!,"SUMMARY REPORT FOR SURGICAL SERVICE"

 W !!,"Enter date range for data to be included on report."

SDATE ; enter starting date

 W !,"Start with date:  " R X:DTIME I '$T!(X["^")!(X="") S SRSOUT=1 G END

 I X["?" W !,"Enter the EARLIEST date for data to be included in this report." S X="?",%DT="EX" D ^%DT G SDATE

 S %DT="EXP" D ^%DT G SDATE:Y<1 S SRSTART=Y

 I SRSTART>DT W !!,"Cannot report on operations for future dates !",! G SDATE

 S SRAC=$O(^SRF("AC",0)) I SRSTART<SRAC S Y=SRAC D DD^%DT S SRAC1=$E(Y,1,12) W !!,"NOTE: ",$S(SRAC:"No surgical case data exists before "_SRAC1_".",1:"There are no surgical cases on record !")

EDATE ; enter ending date

 W !!,"End with date:  " R X:DTIME I '$T!(X["^")!(X="") S SRSOUT=1 G END

 I X["?" W !,"Enter the LATEST date for data to be included in this report." S X="?",%DT="EX" D ^%DT G EDATE

 S %DT="EXP" D ^%DT G EDATE:Y<1 S SREND=Y

 I SRSTART>SREND W !!,"The ENDING date must be later than the BEGINNING date.  Please try again.",! G SDATE

 I SREND>DT W !!,"Cannot report on operations for future dates !",! G EDATE

 S SRFLG=0

 N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2))

IO W ! K %ZIS,IO("Q"),POP S %ZIS("A")="Print report on which Device: ",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1 G END

 I $D(IO("Q")) K IO("Q") S ZTDESC="Summary Report - Surgical Service",(ZTSAVE("SRSTART"),ZTSAVE("SRINSTP"),ZTSAVE("SREND"),ZTSAVE("SRFLG"))="",ZTRTN="EN^SROQ2" D ^%ZTLOAD S SRSOUT=1 G END

EN ; entry point when queued

 D SET,^SROQ1,END

 Q

SET ; collect data

 S SRSD=SRSTART-.0001,SRED=SREND+.9999 D ZERO

 N SRXX S SRXX=$$SITE^SROVAR

 I SRFLG=1 D

 .I SRMULT D  Q

 ..S:'SRIEN SRINST=$P(SRXX,"^",2),SRSTATN=$P(SRXX,"^",3)

 ..S:'$D(SRINSTP) SRINSTP="ALL DIVISIONS",SRINST=SRINST_" - ALL DIVISIONS"

 .S SRINSTP=$P(SRXX,"^"),SRINST=$P(SRXX,"^",2),SRSTATN=+$P(SRXX,"^",3)

 I 'SRFLG D

 .I SRINSTP["ALL DIV" S SRINST=$P(SRXX,"^",2)_" - ALL DIVISIONS",SRSTATN=$P(SRXX,"^",3) Q

 .S SRINST=$$GET1^DIQ(4,SRINSTP,.01),SRSTATN=$$GET1^DIQ(4,SRINSTP,99)

 F  S SRSD=$O(^SRF("AC",SRSD)) Q:SRSD>SRED!('SRSD)  S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN  I $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D CASE

 D MORT^SROQ1A,DEATH S Y=SRSTART D DD^%DT S SRSD=$E(Y,1,12) S Y=SREND D DD^%DT S SRED=$E(Y,1,12),SRYR=$E(Y,9,12) I SRFLG,$E(SRSTART,4,5)=10 S SRYR=SRYR+1

 Q

END W ! I 'SRSOUT,$E(IOST,1,2)="C-" W !!,"Press <RET> to continue  " R X:DTIME

 D KTMP W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP)  S ZTREQ="@" Q

 D ^SRSKILL

 K SR14,SR71,SR72,SR73,SRADMT,SRHAIR,SRHOSP,SRICNR,SRICNE,SRICNO,SRICY,SRIDP,SRINSTP,SRINV,SRIOSTAT,SRTN,SRTONE,SRTONO,SRTOV,SRVER,SRSCY,SRSCNR,SRSCNO,SRSCNE

 D ^%ZISC W @IOF

 Q

KTMP F I="SRDEATH","SRDPT","SRDREL","SRDTH","SREXP","SRINOUT","SRIOD","SRP","SRPROC","SRREL","SRSP","SRSS","SRTN" K ^TMP(I,$J)

 Q

CASE ;  examine case

 Q:$P($G(^SRF(SRTN,30)),"^")!'$P($G(^SRF(SRTN,.2)),"^",12)!($P($G(^SRF(SRTN,"NON")),"^")="Y")

 S SRCASES=SRCASES+1 D ^SROQ0

 Q

ZERO ; set counters to 0

 S (SRTOV,SRTONO,SRTONE,SRICY,SRICNO,SRICNR,SRICNE,SRSCY,SRSCNR,SRSCNO,SRSCNE)=0

 D KTMP S (SR60,SRADMT,SRCASES,SRCOMP,SRDPT,SREMERG,SRIN,SRINPAT,SRIX,SRMAJOR,SRMORT,SROPD,SRSOUT,SRWC)=0 F I=1:1:7 S SRASA(I)=0

 S SRSS=0 F I=48:1:62,78 S SRSPEC(I)=I,^TMP("SRSS",$J,I)="0^0^0^0",SREXP(I)=0

 S ^TMP("SRSS",$J,"ZZ")="0^0^0^0",SREXP("ZZ")=0

 K SRATT F I=9:1:14,99 S (SRATT(I),SRATT("J",I),SRATT("N",I))=0

 F SRPROC=1:1:12 S ^TMP("SRPROC",$J,SRPROC)="0^0",SRDEATH(SRPROC)=0

 S (SRINV("I"),SRINV("O"))=0 F I=1:1:38 S SRC(I)=0

 F I="C","D","N","P","S","U","O","ZZ" S SRHAIR(I)=0

 Q

DEATH ; tabulate deaths

 S SRED=SREND+.9999,SRSD=SRSTART-.0001,DFN=0 F  S DFN=$O(^TMP("SREXP",$J,DFN)) Q:'DFN  D SPEC

 S SRSS=0 F  S SRSS=$O(SREXP(SRSS)) Q:SRSS=""  S ^TMP("SRSS",$J,SRSS)=^TMP("SRSS",$J,SRSS)_"^"_SREXP(SRSS)

 S DFN=0 F  S DFN=$O(^TMP("SRDEATH",$J,DFN)) Q:'DFN  D IP

 F J=1:1:12 S ^TMP("SRPROC",$J,J)=^TMP("SRPROC",$J,J)_"^"_SRDEATH(J)

 S DFN=0 F  S DFN=$O(^TMP("SRIOD",$J,DFN)) Q:'DFN  D INOUT

 Q

SPEC ; determine related specialty

 I $O(^TMP("SRSP",$J,DFN,0))="" S Y=^TMP("SREXP",$J,DFN),SRTN=$P(Y,"^"),SRSS=$P(Y,"^",2),SRDT=$P(^SRF(SRTN,0),"^",9) Q:SRDT>SRED!(SRDT<SRSD)  S SREXP(SRSS)=SREXP(SRSS)+1,SRMORT=SRMORT+1 Q

 S SRDT=$O(^TMP("SRSP",$J,DFN,0)) I (9999999-SRDT)'>SRED&((9999999-SRDT)'<SRSD) S SRSS=^TMP("SRSP",$J,DFN,SRDT),SREXP(SRSS)=SREXP(SRSS)+1,SRMORT=SRMORT+1

 Q

IP ; determine related index procedure (if any)

 I $O(^TMP("SRP",$J,DFN,0))="" S Y=^TMP("SRDEATH",$J,DFN),SRTN=$P(Y,"^"),SRPROC=$P(Y,"^",2),SRDT=$P(^SRF(SRTN,0),"^",9) Q:SRDT>SRED!(SRDT<SRSD)  S SRDEATH(SRPROC)=SRDEATH(SRPROC)+1 Q

 S SRDT=$O(^TMP("SRP",$J,DFN,0)) I (9999999-SRDT)'>SRED&((9999999-SRDT)'<SRSD) S SRPROC=^TMP("SRP",$J,DFN,SRDT),SRDEATH(SRPROC)=SRDEATH(SRPROC)+1

 Q

INOUT ; decide if death is in or out-pat surgery death

 S SRIOSTAT="" I $O(^TMP("SRINOUT",$J,DFN,0))="" S Y=^TMP("SRIOD",$J,DFN),SRTN=$P(Y,"^"),SRIOSTAT=$P(Y,"^",2),SRDT=$P(^SRF(SRTN,0),"^",9) Q:SRDT>SRED!(SRDT<SRSD)!(SRIOSTAT'="O")  S SROPD=SROPD+1 Q

 S SRDT=$O(^TMP("SRINOUT",$J,DFN,0)) S SRIOSTAT=^TMP("SRINOUT",$J,DFN,SRDT) I (9999999-SRDT)'>SRED&((9999999-SRDT)'<SRSD)&(SRIOSTAT="O") S SROPD=SROPD+1

 Q