source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAB54.m@ 1073

Last change on this file since 1073 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1DVBAB54 ;ALB/VM - CAPRI ADMISSION REPORT ;09/06/00
2 ;;2.7;AMIE;**35**;Apr 10, 1995
3 ;
4STRT(ZMSG,BDATE,EDATE) ;ENTER HERE
5 S DVBABCNT=0,RO="N",RONUM=0
6 K ^TMP($J) G TERM
7SET 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
8 Q
9 ;
10PRINTB S ADMDT=$P(DATA,U),DFN=DA D ADM^DVBAVDPT
11 ;W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF
12 ;W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
13 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)
14 S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
15 S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
16 S ZMSG(DVBABCNT)=" Patient Name: "_PNAM,DVBABCNT=DVBABCNT+1
17 S ZMSG(DVBABCNT)=" Claim No: "_CNUM,DVBABCNT=DVBABCNT+1
18 S ZMSG(DVBABCNT)=" Claim Folder Loc: "_CFLOC,DVBABCNT=DVBABCNT+1
19 S ZMSG(DVBABCNT)=" Social Sec No: "_SSN,DVBABCNT=DVBABCNT+1
20 S ZMSG(DVBABCNT)=" Admission Date: "_ADMDT,DVBABCNT=DVBABCNT+1
21 S ZMSG(DVBABCNT)=" Admitting Diagnosis: "_DIAG,DVBABCNT=DVBABCNT+1
22 S ZMSG(DVBABCNT)=" Discharge Date: "_DCHGDT,DVBABCNT=DVBABCNT+1
23 S ZMSG(DVBABCNT)=" Bed Service: "_BEDSEC,DVBABCNT=DVBABCNT+1
24 S ZMSG(DVBABCNT)=" Recv A&A?: "_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1
25 S ZMSG(DVBABCNT)=" Pension?: "_$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1
26 ;D ELIG^DVBAVDPT
27ELIG S ELIG=DVBAELIG,INCMP=""
28 I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
29 I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"")
30 S ZMSG(DVBABCNT)=" Eligibility data: "_ELIG_$S(ELIG]"":", ",1:""),DVBABCNT=DVBABCNT+1
31 I $X>60 S ZMSG(DVBABCNT)=INCMP,DVBABCNT=DVBABCNT+1
32 ;Q
33 ;***VM-OUT*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
34 S DVBAON2=""
35 Q
36 ;
37PRINT K MA S QUIT=""
38 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
39 Q
40PRINT1 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
41 Q
42 ;
43TERM ;D HOME^%ZIS K NOASK
44 ;
45 ;W @IOF,!,"VARO SERVICE-CONNECTED ADMISSION REPORT" D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
46 S DTAR=^DVB(396.1,1,0),FDT(0)=$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3)
47 S HEAD="SERVICE-CONNECTED ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
48 ;W !,HEAD1
49 ;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,!!
50 ;D DATE^DVBAUTIL
51 ;G:X=""!(Y<0) KILL
52 ;S %ZIS="Q" D ^%ZIS K %ZIS G:POP KILL^DVBAUTIL
53 ;
54 ;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)=""
55 ;I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! G KILL
56 ;
57GO 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) "."
58 I '$D(^TMP($J)) S ZMSG(DVBABCNT)="No data found for parameters entered." H 2 G KILL
59 D PRINT I $D(DVBAQUIT) K DVBAON2 D:$D(ZTQUEUED) KILL^%ZTLOAD G KILL^DVBAUTIL
60 ;
61KILL D:$D(ZTQUEUED) KILL^%ZTLOAD D ^%ZISC S X=8 K DVBAON2 G FINAL^DVBAUTIL
62 ;
63DEQUE K ^TMP($J) G GO
Note: See TracBrowser for help on using the repository browser.