| 1 | DVBASCRP ;ALB/GTS-557/THM-SC 7131 ADMISSION RPT ;12/3/90  14:58 | 
|---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995 | 
|---|
| 3 | K ^TMP($J) G TERM | 
|---|
| 4 | SET Q:'$D(^DPT(DA,0))  S DFN=DA,DVBASC="" D SC^DVBAVDPT Q:DVBASC'="Y"  Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)  S ^TMP($J,XCN,CFLOC,MB,DA)=MA | 
|---|
| 5 | Q | 
|---|
| 6 | ; | 
|---|
| 7 | PRINTB S ADMDT=$P(DATA,U),DFN=DA D ADM^DVBAVDPT | 
|---|
| 8 | W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF | 
|---|
| 9 | W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!! | 
|---|
| 10 | S:ADMDT]"" ADMDT=$E(ADMDT,4,5)_"/"_$E(ADMDT,6,7)_"/"_$E(ADMDT,2,3) S:DCHGDT]"" DCHGDT=$E(DCHGDT,4,5)_"/"_$E(DCHGDT,6,7)_"/"_$E(DCHGDT,2,3) | 
|---|
| 11 | W ?10,"Patient Name:",?26,PNAM,!!,?14,"Claim No:",?26,CNUM,!,?6,"Claim Folder Loc:",?26,CFLOC,!,?9,"Social Sec No:",?26,SSN,!,?8,"Admission Date:",?26,ADMDT,!,?3,"Admitting Diagnosis:",?26,DIAG,! | 
|---|
| 12 | W ?8,"Discharge Date:",?26,DCHGDT,!,?11,"Bed Service:",?26,BEDSEC,!,?13,"Recv A&A?:",?26,$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified"),! | 
|---|
| 13 | W ?14,"Pension?:",?26,$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),! D ELIG^DVBAVDPT | 
|---|
| 14 | I IOST?1"C-".E W *7,!,"Press RETURN to continue or ""^"" to stop    " R ANS:DTIME S:ANS=U!('$T) QUIT=1 I '$T S DVBAQUIT=1 | 
|---|
| 15 | S DVBAON2="" | 
|---|
| 16 | Q | 
|---|
| 17 | ; | 
|---|
| 18 | PRINT U IO K MA S QUIT="" | 
|---|
| 19 | S XCN="" F M=0:0 S XCN=$O(^TMP($J,XCN)) Q:XCN=""!(QUIT=1)  S CFLOC="" F J=0:0 S CFLOC=$O(^TMP($J,XCN,CFLOC)) Q:CFLOC=""!(QUIT=1)  D PRINT1 | 
|---|
| 20 | Q | 
|---|
| 21 | PRINT1 S ADM="" F K=0:0 S ADM=$O(^TMP($J,XCN,CFLOC,ADM)) Q:ADM=""!(QUIT=1)  S DA="" F L=0:0 S DA=$O(^TMP($J,XCN,CFLOC,ADM,DA)) Q:DA=""!(QUIT=1)  S DATA=^(DA) D PRINTB | 
|---|
| 22 | Q | 
|---|
| 23 | ; | 
|---|
| 24 | TERM D HOME^%ZIS K NOASK | 
|---|
| 25 | ; | 
|---|
| 26 | W @IOF,!,"VARO SERVICE-CONNECTED ADMISSION REPORT" D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL S DTAR=^DVB(396.1,1,0),FDT(0)=$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3) | 
|---|
| 27 | S HEAD="SERVICE-CONNECTED ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0) | 
|---|
| 28 | W !,HEAD1 | 
|---|
| 29 | W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,8) X ^DD("DD") W Y,!! | 
|---|
| 30 | D DATE^DVBAUTIL | 
|---|
| 31 | G:X=""!(Y<0) KILL | 
|---|
| 32 | S %ZIS="Q" D ^%ZIS K %ZIS G:POP KILL^DVBAUTIL | 
|---|
| 33 | ; | 
|---|
| 34 | I $D(IO("Q")) S ZTRTN="DEQUE^DVBASCRP",ZTIO=ION,NOASK=1,ZTDESC="AMIE SC ADMISSION REPORT" F I="FDT(0)","HEAD","HEAD1","BDATE","EDATE","TYPE","RO","RONUM","NOASK" S ZTSAVE(I)="" | 
|---|
| 35 | I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! G KILL | 
|---|
| 36 | ; | 
|---|
| 37 | GO S MA=BDATE F J=0:0 S MA=$O(^DGPM("AMV1",MA)) Q:$P(MA,".")>EDATE!(MA="")  F DA=0:0 S DA=$O(^DGPM("AMV1",MA,DA)) Q:DA=""  F MB=0:0 S MB=$O(^DGPM("AMV1",MA,DA,MB)) Q:MB=""  D SET W:'$D(NOASK) "." | 
|---|
| 38 | I '$D(^TMP($J)) U IO W !!,*7,"No data found for parameters entered.",!! H 2 G KILL | 
|---|
| 39 | D PRINT I $D(DVBAQUIT) K DVBAON2 D:$D(ZTQUEUED) KILL^%ZTLOAD G KILL^DVBAUTIL | 
|---|
| 40 | ; | 
|---|
| 41 | KILL D:$D(ZTQUEUED) KILL^%ZTLOAD D ^%ZISC S X=8 K DVBAON2 G FINAL^DVBAUTIL | 
|---|
| 42 | ; | 
|---|
| 43 | DEQUE K ^TMP($J) G GO | 
|---|