source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAB3.m@ 1361

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

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1DVBAB3 ;ALB/KLB - CAPRI Amis Report ;05/01/00
2 ;;2.7;AMIE;**35,42**;Apr 10, 1995
3 ;
4STRT(MSG,BDATE,EDATE,RONUMB,SBULL,DUZ) ;
5 S BDATE=BDATE+".0000"
6 S EDATE=EDATE+".2359"
7 S DVBDIV=$P(RONUMB,"^",2)
8 S RONUMB=$P(RONUMB,"^",1)
9 S CNT=0
10 K ^TMP($J)
11 S RONUM=0
12SETUP S UPDATE="N",PREVMO=$P(^DVB(396.1,1,0),U,11)
13 I '$D(DT) S DT=$$DT^XLFDT
14 S DVBCDT(0)=$$FMTE^XLFDT(DT,"5DZ")
15 F JI="3DAYSCH","30DAYEX","PENDADJ" S TOT(JI)=0
16 F JI="INSUFF","SENT","INCOMPLETE","DAYS","COMPLETED" S TOT(JI)=0
17 F JI="P90","P121","P151","P181","P365","P366" S TOT(JI)=0
18 S ^TMP($J,CNT)="REGIONAL OFFICE 2507 AMIS REPORT",CNT=CNT+1
19 ;
20EN S ^TMP($J,CNT)="",CNT=CNT+1,^TMP($J,CNT)="",CNT=CNT+1,^TMP($J,CNT)="",CNT=CNT+1
21 S:'$D(EDATE) MSG(1)="Please enter a ending date"
22 Q:'$D(EDATE)
23 S:'$D(BDATE) MSG(1)="Please enter a starting date"
24 Q:'$D(BDATE)
25 S BDATE1=BDATE-.1,EDATE1=EDATE+.5
26 S:EDATE<BDATE MSG(1)="Beginning date must be before ending date"
27 Q:EDATE<BDATE
28 S:'$D(RONUMB) MSG(1)="Please select a Regional Office number"
29 Q:'$D(RONUMB)
30 S RONUM=$O(^DIC(4,"B",RONUMB,RONUM))
31 I RONUM="" S MSG(1)="Invalid Regional Office number" Q
32 S:'$D(^DIC(4,RONUM,99)) MSG(1)="Invalid Regional Office number"
33 Q:'$D(^DIC(4,RONUM,99))
34 S RONUM=$S($D(^DIC(4,RONUM,99)):$P(^(99),U,1),1:"000")
35 S RONAME=RONUMB
36 S:'$D(SBULL) MSG(1)="You need to say if you want a Bulletin or not"
37 Q:'$D(SBULL)
38 I SBULL="Y" D BULL^DVBAB2
39 ;
40 D GO^DVBAB2
41 K BDATE,BDATE1,DVBCDT,EDATE,CNT,EDATE1,JI,PREVMO,RONAME,RONUM,RONUMB,SBULL,TOT,UPDATE,X,Y,^TMP($J)
42 Q
43INIT(Y) ;
44 ; INITS MAILMAN VARIABLES
45 D INIT^XMVVITAE
46 S Y=XMV("NETNAME")_"^"
47 Q
Note: See TracBrowser for help on using the repository browser.