| 1 | DVBAB56 ;ALB/SPH - CAPRI READMISSION REPORT ;09/05/00
|
|---|
| 2 | ;;2.7;AMIE;**35**;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | STRT(ZMSG,BDATE,EDATE,DVBAH) ;
|
|---|
| 5 | S DVBABCNT=0
|
|---|
| 6 | G TERM
|
|---|
| 7 | SORT D RCV^DVBAVDPT I $D(RONUM),$D(RO) Q:CFLOC'=RONUM&(RO="Y")
|
|---|
| 8 | I RCVAA S ^TMP("DVBA",$J,"A&A",DFN)=""
|
|---|
| 9 | I RCVPEN S ^TMP("DVBA",$J,"PEN",DFN)=""
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | DCHGDT S (LADMDT,LDCHGDT)="",DCHPTR=$P(^DGPM(VY,0),U,17),LADMDT=$P(^(0),U,1) I DCHPTR]"",$D(^DGPM(+DCHPTR,0)) S LDCHGDT=$P(^DGPM(+DCHPTR,0),U,1)
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | CAL S I="",ZI=1 F DVBAI=0:0 S I=$O(^DGPM("APID",DFN,I)) Q:I="" F J=0:0 S J=$O(^DGPM("APID",DFN,I,J)) Q:J="" S ZJ=$S($D(^DGPM(J,0)):^(0),1:"") I $P(ZJ,U,1)'>EDATE,$P(ZJ,U,2)=1 S ^TMP("DVBA",$J,"ADM",DFN,ZI,J)="",ZI=ZI+1
|
|---|
| 16 | S VX=$O(^TMP("DVBA",$J,"ADM",DFN,1,0)) Q:VX="" S CURADMDT=$P(^DGPM(VX,0),U,1) Q:CURADMDT=""
|
|---|
| 17 | F VX=1:1 S VX=$O(^TMP("DVBA",$J,"ADM",DFN,VX)) Q:VX="" F VY=0:0 S VY=$O(^TMP("DVBA",$J,"ADM",DFN,VX,VY)) Q:VY="" D DCHGDT I CURADMDT["."&(LADMDT[".") D SET
|
|---|
| 18 | Q
|
|---|
| 19 | TDIS S TDIS=$S($D(^DGPM(+DCHPTR,0)):$P(^(0),U,18),1:"") Q:TDIS=""
|
|---|
| 20 | S:'$D(^DG(405.2,+TDIS,0)) TDIS="Unknown discharge type" I $D(^(0)) S TDIS=$S($P(^DG(405.2,+TDIS,0),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type")
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | SET S X1=CURADMDT,X2=LDCHGDT D ^%DTC Q:X>185
|
|---|
| 24 | S X2=LADMDT,X1=LDCHGDT D ^%DTC S LOS=X Q:LOS'>HOSPDAYS
|
|---|
| 25 | I DVBAT="A&A" DO ;**Check last admission for A&A vet
|
|---|
| 26 | .S ADMDT=LADMDT
|
|---|
| 27 | .D ADM^DVBAVDPT,TDIS
|
|---|
| 28 | .I TDIS["IRREGULAR" DO ;**Irregular discharge, set last admis info
|
|---|
| 29 | ..S ^TMP("DVBA",DVBAT,$J,XCN,CFLOC,VY,DFN,"LADM")=LADMDT_U_TDIS
|
|---|
| 30 | I $D(TDIS),(TDIS'["IRREGULAR"&(DVBAT="A&A")) Q ;**Quit
|
|---|
| 31 | S ADMDT=CURADMDT
|
|---|
| 32 | D ADM^DVBAVDPT,TDIS
|
|---|
| 33 | ;**Set current admis info
|
|---|
| 34 | S ^TMP("DVBA",DVBAT,$J,XCN,CFLOC,VY,DFN)=CURADMDT_U_RCVAA_U_RCVPEN_U_CNUM_U_TDIS
|
|---|
| 35 | I DVBAT="PEN" DO ;**Set last admis info for Pension vet
|
|---|
| 36 | .S ADMDT=LADMDT
|
|---|
| 37 | .D ADM^DVBAVDPT,TDIS
|
|---|
| 38 | .S ^TMP("DVBA",DVBAT,$J,XCN,CFLOC,VY,DFN,"LADM")=LADMDT_U_TDIS
|
|---|
| 39 | K DVBARADQ
|
|---|
| 40 | S (VX,VY)=9999999
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | TERM ;D HOME^%ZIS
|
|---|
| 44 | K ^TMP("DVBA",$J),^TMP("DVBA","PEN",$J),^TMP("DVBA","A&A",$J),NOASK
|
|---|
| 45 | ;D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
|
|---|
| 46 | ;
|
|---|
| 47 | SETUP ;W @IOF,!,"VARO RE-ADMISSION REPORT"
|
|---|
| 48 | S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
|
|---|
| 49 | S HEAD="RE-ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
|
|---|
| 50 | ;W !,HEAD1
|
|---|
| 51 | EN1 ;W !!,"Please enter admission dates for search, oldest date first,",!,"most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,7) X ^DD("DD") W Y,!!
|
|---|
| 52 | ;D DATE^DVBAUTIL G:Y<0 KILL^DVBAUTIL
|
|---|
| 53 | S BDATE1=BDATE+.5,HEADDT="Date range: "_$$FMTE^XLFDT(BDATE1,"5DZ")_" to "_$$FMTE^XLFDT(EDATE,"5DZ")
|
|---|
| 54 | ;
|
|---|
| 55 | ASK ;W !!,"Do you want (H)ospital or Hospital-(D)om H// " R DVBAH:DTIME G:'$T!(DVBAH=U) KILL^DVBAUTIL
|
|---|
| 56 | I DVBAH="" S DVBAH="H" W DVBAH
|
|---|
| 57 | S:DVBAH="d" DVBAH="D"
|
|---|
| 58 | S:DVBAH="h" DVBAH="H"
|
|---|
| 59 | I DVBAH'?1"H"&(DVBAH'?1"D") W *7,!!,"Must be H for HOSPITAL or D for HOSPITAL-DOM",!! H 3 G ASK
|
|---|
| 60 | S HEAD=HEAD_" ("_$S(DVBAH="H":"Hospital",DVBAH="D":"Hospital-Dom",1:"Unknown selection")_")"
|
|---|
| 61 | S Z=$S(DVBAH="D":1,DVBAH="H":2,1:0) W $P("om^ospital",U,Z),!!
|
|---|
| 62 | ;S %ZIS("B")="0;P-OTHER",%ZIS("A")="Printing device: ",%ZIS="AEQ" D ^%ZIS G:POP KILL^DVBAUTIL
|
|---|
| 63 | I $D(IO("Q")) F I="NOASK","HEAD*","FDT(0)","DTAR","BDATE*","EDATE*","DVBAH" S ZTSAVE(I)=""
|
|---|
| 64 | I S NOASK=1,ZTRTN="DQ^DVBARADM",ZTDESC="AMIE Re-admission Report",ZTIO=ION D ^%ZTLOAD W:$D(ZTSK) !,"Request queued.",!! G KILL^DVBAUTIL
|
|---|
| 65 | GO I '$D(NOASK) W !!,"Looking for Pension and A&A cases ...",!!
|
|---|
| 66 | F DVBADT=BDATE:0 S DVBADT=$O(^DGPM("AMV1",DVBADT)) Q:DVBADT=""!(DVBADT>EDATE) W:'$D(NOASK) "." F DFN=0:0 S DFN=$O(^DGPM("AMV1",DVBADT,DFN)) Q:DFN="" F ADM=0:0 S ADM=$O(^DGPM("AMV1",DVBADT,DFN,ADM)) Q:ADM="" D SORT
|
|---|
| 67 | I '$D(NOASK) W !!,"Examining cases found for re-admissions within 185 days ...",!!
|
|---|
| 68 | F DVBAT="PEN","A&A" S HOSPDAYS=$S(DVBAT="PEN"&(DVBAH="H"):89,DVBAT="PEN"&(DVBAH="D"):59,1:29) F DFN=0:0 S DFN=$O(^TMP("DVBA",$J,DVBAT,DFN)) Q:DFN="" D CAL W:'$D(NOASK) "+"
|
|---|
| 69 | K ^TMP("DVBA",$J,"PEN"),^TMP("DVBA",$J,"A&A")
|
|---|
| 70 | I '$D(^TMP("DVBA","PEN",$J))&('$D(^TMP("DVBA","A&A",$J))) W "No data found for parameters entered." H 2 D:$D(ZTQUEUED) KILL^%ZTLOAD G KILL^DVBAUTIL
|
|---|
| 71 | G ^DVBAB98
|
|---|
| 72 | ;
|
|---|
| 73 | DQ K ^TMP("DVBA",$J),^TMP("DVBA","PEN",$J),^TMP("DVBA","A&A",$J)
|
|---|
| 74 | G GO
|
|---|
