| 1 | ECXTRYIT ;BIR/DMA-Test Run for Setup Extract Print Population ; [ 07/24/96 1:30 PM ]
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;;Dec 22, 1997
|
|---|
| 3 | EN ;entry point from ooption
|
|---|
| 4 | I '$D(DT) S DT=$$HTFM^XLFDT(+$H)
|
|---|
| 5 | W !!,"This option will print the admission data and data for the last",!,"transfer and treating specialty change for all patients who",!,"were in the hospital on the day you select.",!!
|
|---|
| 6 | W !!,"NOTE - This will generate a report of your inpatient population on the",!,"BEGINNING of the day you select, not the end of the day as MAS reports do.",!
|
|---|
| 7 | W "For example, for this report, if you choose October 1, 1994, the report will",!,"start at midnight at the beginning of the day."
|
|---|
| 8 | W " For the MAS report, you would",!,"choose September 30, 1994. The MAS report begins at midnight at the end",!,"of the day.",!!!
|
|---|
| 9 | DATE S DIR(0)="D",DIR("A")="Select the date ",DIR("B")=$$HTE^XLFDT($H-1) D ^DIR K DIR G END:$D(DIRUT) S ECD=Y I Y>DT W !!,"Must be a date in the past",!! G DATE
|
|---|
| 10 | W !!,"This report must be queued to a 132 column printer.",!
|
|---|
| 11 | S %ZIS="NQ" D ^%ZIS K %ZIS G END:POP S ZTSAVE("ECD")="",ZTDESC="Print inpatient list (DSS)",ZTRTN="START^ECXTRYIT" D ^%ZTLOAD
|
|---|
| 12 | END K POP,X,Y,ECD D ^%ZISC Q
|
|---|
| 13 | ;
|
|---|
| 14 | START ;queued entry point
|
|---|
| 15 | K ^TMP($J) S DFN="",ECD0=9999999.9999999-ECD
|
|---|
| 16 | F S DFN=$O(^DGPM("ATID1",DFN)) Q:'DFN S EC1=$O(^(DFN,ECD0)) I EC1 S ECDA=$O(^(EC1,0)) I $D(^DGPM(ECDA,0)) S EC=^(0),ECX=+$P(EC,"^",17),ECAS=$P(EC,"^",18)=40 S:$S('ECX:1,$G(^DGPM(ECX,0))>ECD:1,1:0) ^TMP($J,DFN,ECDA)=$P(EC,"^",6) I ECAS D
|
|---|
| 17 | .F EC1=EC1:0 S EC1=$O(^DGPM("ATID1",DFN,EC1)) Q:'EC1 S ECDA=$O(^(EC1,0)) I ECDA S EC=^DGPM(ECDA,0) I $P(EC,"^",18)'=40 S ECX=$P(EC,"^",17) Q
|
|---|
| 18 | .I EC1,ECDA,$S('ECX:1,'$D(^DGPM(ECX,0)):1,^DGPM(ECX,0)>ECD:1,1:0) S ^TMP($J,DFN,ECDA)=$P(EC,"^",6)
|
|---|
| 19 | ;
|
|---|
| 20 | S DFN=0 F S DFN=$O(^TMP($J,DFN)) Q:'DFN S X=$O(^(DFN,0)) I $O(^(X)) K ^(X)
|
|---|
| 21 | ;if he has an NHCU and an ASIH open, get rid of the NHCU one since
|
|---|
| 22 | ;he may have been transferred in the hospital and we don't want to
|
|---|
| 23 | ;find him twice
|
|---|
| 24 | ;
|
|---|
| 25 | ;now hunt transfers
|
|---|
| 26 | ;
|
|---|
| 27 | S DFN=0 F S DFN=$O(^TMP($J,DFN)),ECCA=0 Q:'DFN F S ECCA=$O(^TMP($J,DFN,ECCA)) Q:'ECCA S ECM=$O(^DGPM("APMV",DFN,ECCA,ECD0)) I ECM S ECDA=$O(^(ECM,0)) I ECDA,ECDA'=ECCA,$D(^DGPM(ECDA,0)) S EC=^(0),^TMP($J,DFN,ECCA)=$P(EC,"^",6)
|
|---|
| 28 | ;
|
|---|
| 29 | ;now put in name order
|
|---|
| 30 | S DFN=0 F S DFN=$O(^TMP($J,DFN)),ECCA=0 Q:'DFN F S ECCA=$O(^TMP($J,DFN,ECCA)) Q:'ECCA D
|
|---|
| 31 | .S W=+^(ECCA),W=$P($G(^DIC(42,W,0)),"^") S:W="" W="unknown" S ^TMP($J,"L",W,$P(^DPT(DFN,0),"^")_"^"_DFN)=$P(^DPT(DFN,0),"^",9)_"^"_$P($P(^DGPM(ECCA,0),"^"),".")
|
|---|
| 32 | ;
|
|---|
| 33 | S W="" F S W=$O(^TMP($J,"L",W)),NAM="" Q:W="" D HEAD F S NAM=$O(^TMP($J,"L",W,NAM)) Q:NAM="" S EC=^(NAM) W !,?5,$P(NAM,"^"),?45,$P(EC,"^"),?66,$$FMTE^XLFDT($P(EC,"^",2)) I $Y+4>IOSL,$O(^TMP($J,"L",W,NAM))]"" D HEAD
|
|---|
| 34 | K ^TMP($J) S ZTREQ="@" D ^%ZISC Q
|
|---|
| 35 | ;
|
|---|
| 36 | HEAD W:$Y @IOF W !!,?30,"INPATIENT WARD LIST (DSS) FOR ",$$FMTE^XLFDT(ECD)," FOR WARD ",W,!!,?12,"PATIENT",?50,"SSN",?66,"ADMIT DATE",!
|
|---|
| 37 | Q
|
|---|
