source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAADRP.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 
1DVBAADRP ;ALB/GTS-557/THM-AMIE COMPLETE ADMISSION RPT ; 1/22/91 1:19 PM
2 ;;2.7;AMIE;**17,42,53,108**;Apr 10, 1995
3 N DVBGUI
4 S DVBGUI=0
5 K ^TMP($J) G TERM
6 Q
7 ;
8ENBROKER(Y) ;
9 ; Returns some info for the CAPRI GUI to display prior
10 ; to the user running this report
11 N DVBGUI
12 S DVBGUI=1
13 K ^TMP($J)
14 D HOME^%ZIS K NOASK,QUIT1
15 D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
16 ;
17 S Y(1)="VARO COMPLETE ADMISSION REPORT" S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
18 S HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
19 S Y(2)=HEAD1,Y(3)=""
20 S Y(4)="Please enter dates for search, oldest date first, most recent date last."
21 S Y=$P(DTAR,U,3) X ^DD("DD")
22 S Y(5)=""
23 S Y(6)="Last report was run on "_Y
24 Q
25ENBROKE2(MSG,BDATE,EDATE,RO,RONUM) ;
26 ; This is the entry point to run the actual report from
27 ; the CAPRI GUI.
28 N DVBHFS,DVBERR,DVBGUI,I
29 K ^TMP("DVBA",$J)
30 S DVBGUI=1,DVBERR=0,DVBHFS=$$HFS^DVBAB82()
31 S X=BDATE,Y=EDATE
32 ; DVBA*2.7*108 - Correct next line. CAPRI GUI already adds 1 to EDATE
33 ; S BDATE=BDATE-.5,EDATE=EDATE+.5
34 S BDATE=BDATE-.5,EDATE=EDATE-.5
35 K ^TMP($J)
36 D HOME^%ZIS K NOASK,QUIT1
37 D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
38 ;
39 S HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
40 I $D(X) D
41 . G:X=""!(Y<0) KILL S %ZIS="AEQ" D ^%ZIS K %ZIS
42 D HFSOPEN^DVBAB82("DVBRP",DVBHFS,"W") I DVBERR D END^DVBAB82 Q
43 I POP K DVBAON2,DCHPTR,M,Y,J G KILL^DVBAUTIL
44 U IO
45 D DEQUE
46 D END^DVBAB82
47 Q
48SET Q:'$D(^DPT(DA,0)) S DFN=DA D RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)
49 S ^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM
50 Q
51 ;
52PRINTB S MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),DFN=DA,QUIT1=1 D ADM^DVBAVDPT
53 S:ADMDT]"" ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
54 S:DCHGDT]"" DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
55 W:(IOST?1"C-".E!($D(DVBAON2))) @IOF
56 I DVBGUI=0 W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
57 I DVBGUI=1 W !!
58 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,!
59 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"),!
60 W ?14,"Pension?:",?26,$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),! D ELIG^DVBAVDPT I IOST'?1"C-".E S DVBAON2=""
61 I IOST?1"C-".E DO
62 .I ($O(^TMP($J,XCN))'=""!($O(^TMP($J,XCN,CFLOC))'=""!($O(^TMP($J,XCN,CFLOC,ADM))'=""!($O(^TMP($J,XCN,CFLOC,ADM,DA))'="")))) DO
63 ..I DVBGUI=0 D
64 ...W *7,!,"Press RETURN to continue or ""^"" to stop "
65 ...R ANS:DTIME
66 ...S:ANS=U!('$T) QUIT=1
67 ...I '$T S DVBAQUIT=1
68 .I ($O(^TMP($J,XCN))=""&($O(^TMP($J,XCN,CFLOC))=""&($O(^TMP($J,XCN,CFLOC,ADM))=""&($O(^TMP($J,XCN,CFLOC,ADM,DA))="")))) DO
69 ..I DVBGUI=0 D
70 ...W *7,!,"Press RETURN to continue "
71 ...R ANS:DTIME
72 Q
73 ;
74PRINT U IO S QUIT="" K MA,MB
75 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
76 Q
77PRINT1 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
78 Q
79 ;
80TERM D HOME^%ZIS K NOASK,QUIT1
81 D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
82 ;
83SETUP W @IOF,!,"VARO COMPLETE ADMISSION REPORT" S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
84 S HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
85 W !,HEAD1
86EN1 W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,3) X ^DD("DD") W Y,!!
87 D DATE^DVBAUTIL
88 G:X=""!(Y<0) KILL S %ZIS="AEQ" D ^%ZIS K %ZIS
89 I POP K DVBAON2,DCHPTR,M,Y,J G KILL^DVBAUTIL
90 ;
91QUEUE I $D(IO("Q")) S ZTRTN="DEQUE^DVBAADRP",ZTIO=ION,NOASK=1,ZTDESC="AMIE ADMISSION REPORT" F I="BDATE","EDATE","HEAD","HEAD1","RO","RONUM","FDT(0)","NOASK" S ZTSAVE(I)=""
92 I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! G KILL
93 ;
94GO S MA=BDATE F J=0:0 S MA=$O(^DGPM("AMV1",MA)) Q:$P(MA,".")>EDATE!(MA="") W:'$D(NOASK) "." 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="" I MA'>EDATE D SET
95 I '$D(^TMP($J)) U IO W !!,*7,"No data found for parameters entered",!! H 2 G KILL
96 I $G(DVBGUI)=1 W !,HEAD,!,HEAD1,!
97 I $D(^TMP($J)) D PRINT I $D(DVBAQUIT) K DVBAON2,DCHPTR,M,Y,J G KILL^DVBAUTIL
98 ;
99KILL ;
100 D ^%ZISC S X=3 K DVBAON2,DCHPTR,M,Y,J D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL
101 ;
102DEQUE K ^TMP($J) G GO
Note: See TracBrowser for help on using the repository browser.