source: FOIAVistA/tag/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAB51.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1DVBAB51 ;ALB/VM - CAPRI INCOMPETENT PATIENT REPORT ;09/01/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,.29)) S ICDAT=^(.29) Q:$P(ICDAT,U,12)'=1&(ICDAT']"") S INCMP="" S:$P(ICDAT,U)]""!($P(ICDAT,U,12)=1) INCMP=1 Q:INCMP'=1 S ICDAT2=$P(ICDAT,U,2),ICDAT=$P(ICDAT,U)
8 S:ICDAT]"" ICDAT=$$FMTE^XLFDT(ICDAT,"5DZ")
9 S:ICDAT2]"" ICDAT2=$$FMTE^XLFDT(ICDAT2,"5DZ")
10 Q:'$D(^DPT(DA,0)) S DFN=DA D RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)
11 S ^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM_U_ICDAT_U_ICDAT2_U_INCMP
12 Q
13 ;
14PRINTB S MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),ICDAT=$P(DATA,U,5),ICDAT2=$P(DATA,U,6),INCMP=$P(DATA,U,7),DFN=DA,QUIT1=1 D ADM^DVBAVDPT
15 S ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
16 S DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
17 S LADM=ADM,TDIS="UNKNOWN",TO="",DCHPTR=$P(^DGPM(LADM,0),U,17),TDIS=$S($D(^DGPM(+DCHPTR,0)):$P(^(0),U,18),1:"") I TDIS="" S TDIS="Unknown discharge type"
18 S:'$D(^DG(405.2,+TDIS,0)) TDIS="Unknown discharge type" I $D(^(0)) S TDIS=$S($P(^DG(405.2,+TDIS,0),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type")
19 S:(IOST?1"C-".E)!($D(DVBAON2)) ZMSG(DVBABCNT)=" ",DVBABCNT=DVBABCNT+1
20 ;***vm-out*W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
21 S ZMSG(DVBABCNT)=" Patient Name: "_PNAM,DVBABCNT=DVBABCNT+1,ZMSG(DVBABCNT)=" ",DVBABCNT=DVBABCNT+1
22 S ZMSG(DVBABCNT)=" Claim No: "_CNUM,DVBABCNT=DVBABCNT+1
23 S ZMSG(DVBABCNT)=" Claim Folder Loc: "_CFLOC,DVBABCNT=DVBABCNT+1
24 S ZMSG(DVBABCNT)=" Social Sec No: "_SSN,DVBABCNT=DVBABCNT+1
25 S ZMSG(DVBABCNT)=" Admission Date: "_ADMDT,DVBABCNT=DVBABCNT+1
26 S ZMSG(DVBABCNT)="Admitting Diagnosis: "_DIAG,DVBABCNT=DVBABCNT+1
27 S ZMSG(DVBABCNT)=" Discharge Date: "_DCHGDT,DVBABCNT=DVBABCNT+1
28 I DCHGDT]"" S ZMSG(DVBABCNT)=" Type of Discharge: "_TDIS_$S(TO]"":" TO "_$S($D(^DIC(4,+TO,0)):$P(^(0),U,1),1:""),1:""),DVBABCNT=DVBABCNT+1
29 S ZMSG(DVBABCNT)=" Bed Service: "_BEDSEC,DVBABCNT=DVBABCNT+1
30 S ZMSG(DVBABCNT)=" Recv A&A?: "_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1
31 S ZMSG(DVBABCNT)=" Pension?: "_$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1
32 ;***vm-out*D ELIG^DVBAVDPT
33ELIG S ELIG=DVBAELIG,INCMP=""
34 S ZMSG(DVBABCNT)=" Eligibility data: "
35 I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
36 I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"")
37 S ZMSG(DVBABCNT)=ELIG_$S(ELIG]"":", ",1:"")_INCMP,DVBABCNT=DVBABCNT+1
38 S ZMSG(DVBABCNT)=" DATE RULED INCOMP: "_$S($D(ICDAT)]"":ICDAT_" (VA)",1:"")_$S(ICDAT2]"":" - "_ICDAT2_" (CIVIL)",1:" "),DVBABCNT=DVBABCNT+1
39 ;***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
40 S DVBAON2=""
41 Q
42 ;
43PRINT U IO S QUIT=""
44 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
45 Q
46PRINT1 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
47 Q
48 ;
49TERM ;D HOME^%ZIS K NOASK
50 K NOASK
51 ;
52SETUP ;W @IOF,!,"VARO INCOMPETENCY REPORT" D NOPARM^DVBAUTL2
53NOPARM ;check for AMIE parameter setup
54 I '$D(^DVB(396.1,1,0)) S ZMSG(DVBABCNT)="No site parameters have been set up in file 396.1.",DVBABCNT=DVBABCNT+1,ZMSG(DVBABCNT)="You must do this before running any reports." S DVBAQUIT=1 H 3
55 G:$D(DVBAQUIT) KILL^DVBAUTIL S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
56 S HEAD="INCOMPETENCY REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
57 ;***vm-out*W !,HEAD1
58EN1 ;***vm-out*W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,5) X ^DD("DD") W Y,!!
59 ;***vm-out*D DATE^DVBAUTIL G:X=""!(Y<0) KILL
60 S %ZIS="Q" D ^%ZIS K %ZIS G:POP KILL^DVBAUTIL
61 ;
62QUEUE ;***vm-out*I $D(IO("Q")) S ZTRTN="DEQUE^DVBACMRP",ZTIO=ION,NOASK=1,ZTDESC="AMIE INCOMPETENT VET REPORT" F I="FDT(0)","HEAD","HEAD1","BDATE","EDATE","TYPE","RO","RONUM","NOASK" S ZTSAVE(I)=""
63 ;***vm-out*I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! G KILL
64 ;
65GO 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 I '$D(NOASK) W "."
66 I '$D(^TMP($J)) S ZMSG(DVBABCNT)="No data found for parameters entered." H 2 G KILL
67 I $D(^TMP($J)) D PRINT I $D(DVBAQUIT) K DVBAON2 G KILL^DVBAUTIL
68 ;
69KILL D ^%ZISC S X=5 K DVBAON2 D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL
70 ;
71DEQUE K ^TMP($J) G GO
Note: See TracBrowser for help on using the repository browser.