source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCREQ2.m@ 1147

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1DVBCREQ2 ;557/THM-CHECK DATES TO PRINT NEW REQUESTS ; 4/17/91 8:42 AM
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;Skips Saturday if indicated in file, skips Sunday always
4 ;If Saturday is skipped, is printed on Monday
5 ;Holidays queue up for T+1 at current time unless Saturday,
6 ;when they queue for T+3 at current time.
7 ;
8EN I '$D(DT) S X="T" D ^%DT S DT=Y
9 D NOW^%DTC S DVBCNOW=%H,X=DT D DW^%DTC S TODAY=X,DVBCNSKP=$P(^DVB(396.1,1,0),U,14)
10 I $D(^HOLIDAY(DT)) G HOLIDAY
11 I TODAY="SATURDAY"&(DVBCNSKP'="Y")!(TODAY="SUNDAY") G EXIT
12 G TASK
13 ;
14EXIT K %,%H,Y,X,TODAY,DVBCNSKP
15 Q
16 ;
17TASK I '$D(^DVB(396.1,1,0)) W !!,"No parameters in AMIE site parameter file!",!! Q
18 I TODAY="SATURDAY"&(DVBCNSKP="Y") S X="T-1" D ^%DT S BDTRQ=Y,EDTRQ=Y+.2359 G TASK1 ;Friday's requests
19 I TODAY="SATURDAY"&(DVBCNSKP'="Y") G EXIT ;don't print Friday if not Y
20 I TODAY="MONDAY"&(DVBCNSKP'="Y") S X="T-3" D ^%DT S BDTRQ=Y,X="T-1" D ^%DT S EDTRQ=Y+.2359 G TASK1 ;Friday-Sunday
21 I TODAY="MONDAY"&(DVBCNSKP="Y") S X="T-2" D ^%DT S BDTRQ=Y,X="T-1" D ^%DT S EDTRQ=Y+.2359 G TASK1 ;Saturday-Sunday
22 S X="T-1" D ^%DT S BDTRQ=Y,EDTRQ=Y+.2359 ;Monday-Friday
23 ;
24TASK1 S Y=DT X ^DD("DD") S DVBCDT(0)=Y F JI=0:0 S JI=$O(^DVB(396.1,1,3,"B",JI)) Q:JI="" F JJ=0:0 S JJ=$O(^DVB(396.1,1,3,"B",JI,JJ)) Q:JJ="" D CLIN
25 G EXIT
26 ;
27CLIN S XDIV=JI,ZTRTN="GO^DVBCREQP",ZTIO=$P(^DVB(396.1,1,3,JJ,0),U,2)_";80",ZTDESC="New 2507 Request Report for ",DIVNM=$S($D(^DG(40.8,XDIV,0)):$P(^(0),U,1),1:"Unknown Division"),ZTDESC=ZTDESC_DIVNM S:'$D(ZTDTH) ZTDTH=$H
28 F I="BDTRQ*","EDTRQ*","DA*","DVBCDT(0)","Y","XDIV","DIVNM","JI","JJ" S ZTSAVE(I)=""
29 D ^%ZTLOAD
30 Q
31 ;
32HOLIDAY ;holidays are queued for next day at same time
33 I TODAY="MONDAY",DVBCNSKP="Y" S X="T-2" D ^%DT S BDTRQ=Y,X="T-1" D ^%DT S EDTRQ=Y+.2359,ZTDTH=$P(DVBCNOW,",",1)+1_","_$P(DVBCNOW,",",2) G TASK1 ;Saturday-Sunday requests
34 I TODAY="MONDAY",DVBCNSKP'="Y" S X="T-3" D ^%DT S BDTRQ=Y,X="T-1" D ^%DT S EDTRQ=Y+.2359,ZTDTH=$P(DVBCNOW,",",1)+1_","_$P(DVBCNOW,",",2) G TASK1 ;Friday-Sunday requests
35 I TODAY="TUESDAY"!(TODAY="WEDNESDAY")!(TODAY="THURSDAY") S X="T-1" D ^%DT S BDTRQ=Y,EDTRQ=Y+.2359,ZTDTH=$P(DVBCNOW,",",1)+1_","_$P(DVBCNOW,",",2) G TASK1 ;Monday-Wednesday requests
36 I TODAY="FRIDAY" S X="T-1" D ^%DT S BDTRQ=Y,EDTRQ=Y+.2359,ZTDTH=$P(DVBCNOW,",",1)+3_","_$P(DVBCNOW,",",2) G TASK1 ;Thursday requests
Note: See TracBrowser for help on using the repository browser.