source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBASPD2.m

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

initial load of FOIAVistA 6/30/08 version

File size: 5.1 KB
Line 
1DVBASPD2 ;ALB/GTS-557/THM-AMIE SPECIAL REPORT ; 9/15/91 8:22 PM
2 ;;2.7;AMIE;**3,57**;Apr 10, 1995
3 K ^TMP($J) G TERM
4SET Q:'$D(^DPT(DA,0)) S DFN=DA D RCV^DVBAVDPT Q:RCVPEN'=1&(REP="P") Q:RCVAA'=1&(REP="A") Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)
5 S DCHPTR=$P(^DGPM(MB,0),U,17),TDIS=$S($D(^DGPM(+DCHPTR,0)):$P(^(0),U,18),1:"")
6 I +TDIS,'$D(^TMP("DVBA",$J,"DUP",+TDIS)) Q
7 S TDIS=$S($P($G(^DG(405.2,+TDIS,0)),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type")
8 S ^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM_U_TDIS
9 Q
10 ;
11PRINTB W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF
12 W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
13 W ?10,REP(0),?26,PNAM,!!,?14,REP(1),?26,CNUM,!,?6,REP(2),?26,XCFLOC,!,?9,REP(3),?26,SSN,!,?8,REP(4),?26,ADMDT,!,?3,REP(5),?26,DIAG,!
14 W ?8,REP(6),?26,DCHGDT,! W:DCHGDT]"" ?5,REP(7),?26,$$DIS,!
15 W ?11,REP(8),?26,BEDSEC,!,?13,REP(9),?26,$$RAA,!
16 W ?14,REP(10),?26,$$PEN,! D ELIG^DVBAVDPT
17 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 I '$T S DVBAQUIT=1
18 S DVBAON2=""
19 Q
20RAA() Q $S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")
21PEN() Q $S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")
22DIS() Q TDIS_$S(TO]"":" TO "_$S($D(^DIC(4,+TO,0)):$P(^(0),U,1),1:""),1:"")
23SP(N,M) S $P(M," ",N-1)=" " Q M ;pass one arg, 2nd for local use
24PRINTC F J=0:1:7 S ^TMP("DVBSPCRP",$J,DVBC+J)=DVBS(J) ;NakedRefs = ^TMP("DVBSPCRP",$J,DVBC+J)
25 S DVBC=DVBC+6,^TMP("DVBSPCRP",$J,DVBC)=$$SP(10)_REP(0)_PNAM
26 S ^(DVBC+2)=$$SP(14)_REP(1)_CNUM
27 S ^(DVBC+3)=$$SP(6)_REP(2)_XCFLOC
28 S ^(DVBC+4)=$$SP(9)_REP(3)_SSN
29 S ^(DVBC+5)=$$SP(8)_REP(4)_ADMDT
30 S ^(DVBC+6)=$$SP(3)_REP(5)_DIAG
31 S DVBC=DVBC+7,^(DVBC)=$$SP(8)_REP(6)_DCHGDT
32 I DCHGDT]"" D
33 .S DVBC=DVBC+1,^(DVBC)=$$SP(5)_REP(7)_$$DIS
34 S ^(DVBC+1)=$$SP(11)_REP(8)_BEDSEC
35 S ^(DVBC+2)=$$SP(13)_REP(9)_$$RAA
36 S DVBC=DVBC+3,^(DVBC)=$$SP(14)_REP(10)_$$PEN
37 D ELIG^DVBAVDPT
38 Q
39PRINT S QUIT="",XCN=""
40 F S XCN=$O(^TMP($J,XCN)) Q:XCN=""!(QUIT=1) S XCFLOC="" F S XCFLOC=$O(^TMP($J,XCN,XCFLOC)) Q:XCFLOC=""!(QUIT=1) D PRINT1
41 Q
42PRINT1 S ADM="" F S ADM=$O(^TMP($J,XCN,XCFLOC,ADM)) Q:ADM=""!(QUIT=1) D
43 .S DA="" F S DA=$O(^TMP($J,XCN,XCFLOC,ADM,DA)) Q:DA=""!(QUIT=1) D
44 ..S DATA=^(DA),MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3)
45 ..S CNUM=$P(DATA,U,4),TDIS=$P(DATA,U,5),DFN=DA,TO="",QUIT1=1
46 ..D ADM^DVBAVDPT
47 ..S:ADMDT]"" ADMDT=$E(ADMDT,4,5)_"/"_$E(ADMDT,6,7)_"/"_$E(ADMDT,2,3)
48 ..S:DCHGDT]"" DCHGDT=$E(DCHGDT,4,5)_"/"_$E(DCHGDT,6,7)_"/"_$E(DCHGDT,2,3)
49 ..I $$BROKER^XWBLIB D PRINTC Q
50 ..D PRINTB
51 Q
52SETUP S RPT="VARO REPORT"_$S(REP="A":" FOR A & A",1:" FOR PENSION"),DTAR=^DVB(396.1,1,0),FDT(0)=$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3)
53 S HEAD="SPECIAL "_$S(REP="A":"A & A",1:"PENSION")_" REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
54 S Y=$P(DTAR,U,9) X ^DD("DD") S REP("LRUN")="Last report was run on "_Y
55 S REP(0)="Patient Name:",REP(1)="Claim No:"
56 S REP(2)="Claim Folder Loc:",REP(3)="Social Sec No:"
57 S REP(4)="Admission Date:",REP(5)="Admitting Diagnosis:"
58 S REP(6)="Discharge Date:",REP(7)="Type of Discharge:"
59 S REP(8)="Bed Service:",REP(9)="Recv A&A?:",REP(10)="Pension?:"
60 Q
61TERM D HOME^%ZIS,SETUP K NOASK
62 W @IOF,!,RPT,!,HEAD1
63 ;
64EN1 W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,REP("LRUN"),!!
65 D DATE^DVBAUTIL
66 G:X=""!(Y<0) KILL
67 S %ZIS="Q" D ^%ZIS K %ZIS G:POP KILL^DVBAUTIL
68 ;
69QUEUE I $D(IO("Q")) S ZTRTN="DEQUE^DVBASPD2",ZTIO=ION,NOASK=1,ZTDESC="AMIE PENSION/A&A REPORT" F I="^TMP(""DVBA"",$J,""DUP"",","DVBATYPS","REP","FDT(0)","HEAD","HEAD1","BDATE","EDATE","TYPE","RO","RONUM","NOASK" S ZTSAVE(I)=""
70 I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! G KILL
71 ;
72GO S MA=BDATE F 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="" D SET
73 S:'$D(^TMP($J)) ER="No data found for parameters entered."
74 G:$$BROKER^XWBLIB BROKER
75 U IO I $D(ER) W !!,*7,ER,!! G KILL
76 D PRINT
77 I $D(DVBAQUIT) D:$D(ZTQUEUED) KILL^%ZTLOAD K ER,DVBAON2 G KILL^DVBAUTIL
78 ;
79KILL D ^%ZISC D:$D(ZTQUEUED) KILL^%ZTLOAD S X=9 K ER,DVBAON2 G FINAL^DVBAUTIL
80 ;
81INIT F J=0,2,5,6,7 S DVBS(J)=" "
82 S $P(DVBS(1),"-",70)="-",DVBS(3)=$$SP(70-$L(HEAD)\2)_HEAD,DVBS(4)=$$SP(70-$L(HEAD1)\2)_HEAD1
83 S ^TMP("DVBSPCRP",$J,1)=" ",^(2)=RPT,^(3)=HEAD1,^(4)=" ",^(5)=REP("LRUN"),DVBC=6
84 F J=0:1:10 S REP(J)=REP(J)_" "
85 Q
86BROKER I $D(ER) K ^TMP("DVBSPCRP",$J) S ^($J,1)=ER
87 E D INIT,PRINT
88 S X=9 G FINAL^DVBAUTIL
89 ;
90SPECRPT(ZMSG,DCTYPES,BDATE,EDATE,RONUM,REP) ;
91 N I,J,REQ,DVBC,DVBACEPT,DVBS,ER
92 S ZMSG=$NA(^TMP("DVBSPCRP",$J)),RONUM=+$G(RONUM),REQ=" IS REQUIRED"
93 S MB=" MUST BE ",TYPE="REPORT TYPE",BDT="BEGINNING DATE",EDT="ENDING DATE"
94 I $G(BDATE)="" S ER=BDT_REQ
95 I $G(EDATE)="" S ER=EDT_REQ
96 I EDATE<BDATE S ER=BDT_MB_"BEFORE THE "_EDT
97 I $G(REP)="" S ER=TYPE_REQ
98 I "^A^P"'[REP S ER=TYPE_MB_"'A' OR 'P'"
99 I $D(RONUM)&(RONUM'?1.3N) S ER="REGIONAL OFFICE"_MB_"1-3 NUMBERS"
100 K ^TMP("DVBSPCRP",$J) I $D(ER) S ^($J,1)=ER,X=9 G FINAL^DVBAUTIL
101 S (NOASK,DVBACEPT)=1,RO=$S(RONUM=0:"N",1:"Y")
102 F J=0:0 S J=$O(DCTYPES(J)) Q:'J S ^TMP("DVBA",$J,"DUP",DCTYPES(J))=""
103 D SETUP
104DEQUE K ^TMP($J) G GO
105 ;
Note: See TracBrowser for help on using the repository browser.