- DVBCREQ2 ;557/THM-CHECK DATES TO PRINT NEW REQUESTS ; 4/17/91 8:42 AM
- ;;2.7;AMIE;;Apr 10, 1995
- ;Skips Saturday if indicated in file, skips Sunday always
- ;If Saturday is skipped, is printed on Monday
- ;Holidays queue up for T+1 at current time unless Saturday,
- ;when they queue for T+3 at current time.
- ;
- EN I '$D(DT) S X="T" D ^%DT S DT=Y
- D NOW^%DTC S DVBCNOW=%H,X=DT D DW^%DTC S TODAY=X,DVBCNSKP=$P(^DVB(396.1,1,0),U,14)
- I $D(^HOLIDAY(DT)) G HOLIDAY
- I TODAY="SATURDAY"&(DVBCNSKP'="Y")!(TODAY="SUNDAY") G EXIT
- G TASK
- ;
- EXIT K %,%H,Y,X,TODAY,DVBCNSKP
- Q
- ;
- TASK I '$D(^DVB(396.1,1,0)) W !!,"No parameters in AMIE site parameter file!",!! Q
- I TODAY="SATURDAY"&(DVBCNSKP="Y") S X="T-1" D ^%DT S BDTRQ=Y,EDTRQ=Y+.2359 G TASK1 ;Friday's requests
- I TODAY="SATURDAY"&(DVBCNSKP'="Y") G EXIT ;don't print Friday if not Y
- 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
- 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
- S X="T-1" D ^%DT S BDTRQ=Y,EDTRQ=Y+.2359 ;Monday-Friday
- ;
- TASK1 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
- G EXIT
- ;
- CLIN 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
- F I="BDTRQ*","EDTRQ*","DA*","DVBCDT(0)","Y","XDIV","DIVNM","JI","JJ" S ZTSAVE(I)=""
- D ^%ZTLOAD
- Q
- ;
- HOLIDAY ;holidays are queued for next day at same time
- 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
- 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
- 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
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCREQ2 2347 printed Mar 13, 2025@20:53:09 Page 2
- DVBCREQ2 ;557/THM-CHECK DATES TO PRINT NEW REQUESTS ; 4/17/91 8:42 AM
- +1 ;;2.7;AMIE;;Apr 10, 1995
- +2 ;Skips Saturday if indicated in file, skips Sunday always
- +3 ;If Saturday is skipped, is printed on Monday
- +4 ;Holidays queue up for T+1 at current time unless Saturday,
- +5 ;when they queue for T+3 at current time.
- +6 ;
- EN IF '$DATA(DT)
- SET X="T"
- DO ^%DT
- SET DT=Y
- +1 DO NOW^%DTC
- SET DVBCNOW=%H
- SET X=DT
- DO DW^%DTC
- SET TODAY=X
- SET DVBCNSKP=$PIECE(^DVB(396.1,1,0),U,14)
- +2 IF $DATA(^HOLIDAY(DT))
- GOTO HOLIDAY
- +3 IF TODAY="SATURDAY"&(DVBCNSKP'="Y")!(TODAY="SUNDAY")
- GOTO EXIT
- +4 GOTO TASK
- +5 ;
- EXIT KILL %,%H,Y,X,TODAY,DVBCNSKP
- +1 QUIT
- +2 ;
- TASK IF '$DATA(^DVB(396.1,1,0))
- WRITE !!,"No parameters in AMIE site parameter file!",!!
- QUIT
- +1 ;Friday's requests
- IF TODAY="SATURDAY"&(DVBCNSKP="Y")
- SET X="T-1"
- DO ^%DT
- SET BDTRQ=Y
- SET EDTRQ=Y+.2359
- GOTO TASK1
- +2 ;don't print Friday if not Y
- IF TODAY="SATURDAY"&(DVBCNSKP'="Y")
- GOTO EXIT
- +3 ;Friday-Sunday
- IF TODAY="MONDAY"&(DVBCNSKP'="Y")
- SET X="T-3"
- DO ^%DT
- SET BDTRQ=Y
- SET X="T-1"
- DO ^%DT
- SET EDTRQ=Y+.2359
- GOTO TASK1
- +4 ;Saturday-Sunday
- IF TODAY="MONDAY"&(DVBCNSKP="Y")
- SET X="T-2"
- DO ^%DT
- SET BDTRQ=Y
- SET X="T-1"
- DO ^%DT
- SET EDTRQ=Y+.2359
- GOTO TASK1
- +5 ;Monday-Friday
- SET X="T-1"
- DO ^%DT
- SET BDTRQ=Y
- SET EDTRQ=Y+.2359
- +6 ;
- TASK1 SET Y=DT
- XECUTE ^DD("DD")
- SET DVBCDT(0)=Y
- FOR JI=0:0
- SET JI=$ORDER(^DVB(396.1,1,3,"B",JI))
- if JI=""
- QUIT
- FOR JJ=0:0
- SET JJ=$ORDER(^DVB(396.1,1,3,"B",JI,JJ))
- if JJ=""
- QUIT
- DO CLIN
- +1 GOTO EXIT
- +2 ;
- CLIN SET XDIV=JI
- SET ZTRTN="GO^DVBCREQP"
- SET ZTIO=$PIECE(^DVB(396.1,1,3,JJ,0),U,2)_";80"
- SET ZTDESC="New 2507 Request Report for "
- SET DIVNM=$SELECT($DATA(^DG(40.8,XDIV,0)):$PIECE(^(0),U,1),1:"Unknown Division")
- SET ZTDESC=ZTDESC_DIVNM
- if '$DATA(ZTDTH)
- SET ZTDTH=$HOROLOG
- +1 FOR I="BDTRQ*","EDTRQ*","DA*","DVBCDT(0)","Y","XDIV","DIVNM","JI","JJ"
- SET ZTSAVE(I)=""
- +2 DO ^%ZTLOAD
- +3 QUIT
- +4 ;
- HOLIDAY ;holidays are queued for next day at same time
- +1 ;Saturday-Sunday requests
- IF TODAY="MONDAY"
- IF DVBCNSKP="Y"
- SET X="T-2"
- DO ^%DT
- SET BDTRQ=Y
- SET X="T-1"
- DO ^%DT
- SET EDTRQ=Y+.2359
- SET ZTDTH=$PIECE(DVBCNOW,",",1)+1_","_$PIECE(DVBCNOW,",",2)
- GOTO TASK1
- +2 ;Friday-Sunday requests
- IF TODAY="MONDAY"
- IF DVBCNSKP'="Y"
- SET X="T-3"
- DO ^%DT
- SET BDTRQ=Y
- SET X="T-1"
- DO ^%DT
- SET EDTRQ=Y+.2359
- SET ZTDTH=$PIECE(DVBCNOW,",",1)+1_","_$PIECE(DVBCNOW,",",2)
- GOTO TASK1
- +3 ;Monday-Wednesday requests
- IF TODAY="TUESDAY"!(TODAY="WEDNESDAY")!(TODAY="THURSDAY")
- SET X="T-1"
- DO ^%DT
- SET BDTRQ=Y
- SET EDTRQ=Y+.2359
- SET ZTDTH=$PIECE(DVBCNOW,",",1)+1_","_$PIECE(DVBCNOW,",",2)
- GOTO TASK1
- +4 ;Thursday requests
- IF TODAY="FRIDAY"
- SET X="T-1"
- DO ^%DT
- SET BDTRQ=Y
- SET EDTRQ=Y+.2359
- SET ZTDTH=$PIECE(DVBCNOW,",",1)+3_","_$PIECE(DVBCNOW,",",2)
- GOTO TASK1
