source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAB53.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1DVBAB53 ;ALB/SPH - CAPRI DISCHARGE REPORT ; 20 Jul 2005 3:39 PM
2 ;;2.7;AMIE;**35,99,100**;Apr 10, 1995
3 ;
4STRT(ZMSG,BDATE,EDATE,ADTYPE) ;
5 I BDATE'["." S BDATE=BDATE-.0001 ; DVBA*2.7*99
6 S DVBABCNT=0
7 S RONUM=0
8 S RO="N"
9 S HEAD="",HEAD1=""
10 K ^TMP($J) G TERM
11 ;
12SET Q:'$D(^DPT(DA,0)) S DFN=DA,DVBASC="" D RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376) Q:ADTYPE="S"&(DVBASC'="Y") Q:ADTYPE="A"&(RCVAA'=1) Q:ADTYPE="P"&(RCVPEN'="1")
13 S TDIS=$S($D(^DGPM(+MB,0)):$P(^(0),U,18),1:"")
14 I $D(^DG(405.2,+TDIS,0)) DO
15 . ; I '$D(^TMP("DVBA",$J,"DUP",+TDIS)) Q ; DVBA*2.7*99 commented out
16 .I '$D(DISTYPE(+TDIS)) Q
17 .S TDIS=$S($P(^DG(405.2,+TDIS,0),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type")
18 .S ^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM_U_TDIS
19 .Q
20 Q
21 ;
22PRINTB S MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),TDIS=$P(DATA,U,5),DFN=DA,QUIT1=1 D DCHGDT^DVBAVDPT
23 W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF
24 W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
25 S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
26 ;
27 S ZMSG(DVBABCNT)=" Patient Name: "_PNAM S DVBABCNT=DVBABCNT+1
28 S ZMSG(DVBABCNT)=" Claim No: "_CNUM S DVBABCNT=DVBABCNT+1
29 S ZMSG(DVBABCNT)=" Claim Folder Loc: "_CFLOC S DVBABCNT=DVBABCNT+1
30 S ZMSG(DVBABCNT)=" Social Sec No: "_SSN S DVBABCNT=DVBABCNT+1
31 S ZMSG(DVBABCNT)=" Discharge Date: "_$$FMTE^XLFDT(DCHGDT,"5DZ"),DVBABCNT=DVBABCNT+1
32 S ZMSG(DVBABCNT)=" Type of Discharge: "_TDIS,DVBABCNT=DVBABCNT+1
33 D LOS^DVBAUTIL
34 S ZMSG(DVBABCNT)=" Length of Stay: "_LOS_$S(LOS="":"Discharged same day",LOS=1:" day",1:" days"),DVBABCNT=DVBABCNT+1
35 S ZMSG(DVBABCNT)=" Bed Service: "_BEDSEC,DVBABCNT=DVBABCNT+1
36 S ZMSG(DVBABCNT)=" Recv A&A?: "_$S(RCVAA="0":"NO",RCVAA="1":"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1
37 S ZMSG(DVBABCNT)=" Pension?: "_$S(RCVPEN="0":"NO",RCVPEN="1":"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1
38 ;
39 ;
40 ; ELIG INFO...
41 S ELIG=DVBAELIG,INCMP=""
42 ;S ZMSG(DVBABCNT)=" Eligibility data:"
43 I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
44 I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"")
45 S ZMSG(DVBABCNT)=" Eligibility data: "_ELIG_$S(ELIG]"":", ",1:"") S DVBABCNT=DVBABCNT+1
46 W:$X>60 !?26 S ZMSG(DVBABCNT)=INCMP S DVBABCNT=DVBABCNT+1
47 Q
48 ;END OF ELIG INFO
49 ;
50 ;I IOST?1"C-".E W *7,!,"Press RETURN to continue or ""^"" to stop " R ANS:DTIME S:ANS=U!('$T) QUIT=1 I ANS=U S DVBAQUIT=1
51 S DVBAON2=""
52 Q
53 ;
54PRINT U IO S QUIT=""
55 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
56 Q
57PRINT1 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
58 Q
59 ;
60TERM ;D HOME^%ZIS K NOASK
61 ;
62SETUP ;W @IOF,!,"VARO DISCHARGE REPORT" D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
63 S DSRP=1
64 ;S HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0) W !,HEAD1
65 ;
66EN1 ;W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,4) X ^DD("DD") W Y,!!
67 ;D DATE^DVBAUTIL
68 ;G:X=""!(Y<0) KILL
69 ;
70ADTYPE ;D ADTYPE^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
71 ;W @IOF
72 ;K DVBACEPT
73 D EN^DVBAB99("DVBA DISCHARGE TYPES")
74 D ACCEPT^DVBALD
75 I '$D(DVBACEPT) D KILL^DVBAUTIL Q
76 I '$O(^TMP("DVBA",$J,"DUP",0)) D KILL^DVBAUTIL Q
77 M DISTYPE=^TMP("DVBA",$J,"DUP")
78 ;
79 ; DVBA*2.7*100 - commented out next line
80 ; W !!! S %ZIS="Q" D ^%ZIS K %ZIS G:POP KILL^DVBAUTIL
81 ;
82QUEUE I $D(IO("Q")) S ZTRTN="DEQUE^DVBADSRT",ZTIO=ION,NOASK=1,ZTDESC="AMIE DISCHARGE REPORT" F I="DISTYPE(","ADTYPE","DVBATYPS","BDATE","BDATE1","EDATE","FDT(0)","HEAD","HEAD1","HD","RO","RONUM","NOASK" S ZTSAVE(I)=""
83 I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",! G KILL
84 ;
85GO S MA=BDATE F J=0:0 S MA=$O(^DGPM("AMV3",MA)) Q:MA>EDATE!(MA="") W:'$D(NOASK) "." F DA=0:0 S DA=$O(^DGPM("AMV3",MA,DA)) Q:DA="" F MB=0:0 S MB=$O(^DGPM("AMV3",MA,DA,MB)) Q:MB="" D SET
86 I '$D(^TMP($J)) U IO W !!,*7,"No data found for parameters entered.",!! H 2 G KILL
87 D PRINT I $D(DVBAQUIT) K DVBAON2,DISTYPE G KILL^DVBAUTIL
88 ;
89KILL D ^%ZISC D:$D(ZTQUEUED) KILL^%ZTLOAD S X=4 K DVBAON2,DISTYPE G FINAL^DVBAUTIL
90 ;
91DEQUE K ^TMP($J) G GO
Note: See TracBrowser for help on using the repository browser.