- RCEVUTL1 ;WASH-ISC@ALTOONA,PA/LDB-Generic Event Utilities ;2/28/95 8:36 AM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- DATE(RANGE) ;Select date range or range of activity
- ;RANGE=$P1 (Prompt for type of range)
- ; $P2 (Prompt for default for beginning of range) NULL is FIRST
- ; $P3 (Prompt for default for end of range) NULL is LAST
- ; $P4 (%DT variable will be set to this type of date)
- ; $P5 (%DT(0) variable will be set to this date constraint)
- N %DT,DATE,FDT,X,Y
- BEG ;Select beginnning of range
- S %DT=$S($P(RANGE,"^",4)]"":$P(RANGE,"^",4),1:"T")
- S:$P(RANGE,"^",5)]"" %DT(0)=$P(RANGE,"^",5)
- S FDT=$S($P(RANGE,"^",2)]"":$$SLH^RCFN01($P(RANGE,"^",2)),1:"FIRST")
- W !,"Enter the beginning "_$S($P(RANGE,"^")]"":$P(RANGE,"^"),1:"DATE")_" : "_FDT_"// " R X:DTIME
- I '$T!(X="^") S Y=-1 Q Y
- I X="?" W !,"Examples of Valid Date: JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057" G BEG
- I X="" S (X,Y)=$P(RANGE,"^",2)
- I X]"" D ^%DT G:Y=-1 BEG
- S DATE=+Y X ^DD("DD") W " ",Y
- ;
- END ;Select ending of range
- S %DT=$S($P(RANGE,"^",4)]"":$P(RANGE,"^",4),1:"T")
- S:$P(RANGE,"^",5)]"" %DT(0)=$P(RANGE,"^",5)
- W !,"Enter the ending "_$S($P(RANGE,"^")]"":$P(RANGE,"^"),1:"DATE")_" : "_$S($P(RANGE,"^",3)]"":$$SLH^RCFN01($P(RANGE,"^",3)),1:"LAST")_"// " R X:DTIME
- I '$T!(X="^") S Y=-1 Q Y
- I X="?" W !,"Examples of Valid Date: JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057" G END
- I X="" S X=$S($P(RANGE,"^",3)]"":$P(RANGE,"^",3),1:"")
- I X="" S Y=0 S DATE=DATE_"^"_Y Q DATE
- I X]"" D ^%DT D G:Y=-1 END
- .I Y<DATE W !,*7,"Must be equal to or greater than beginning "_$S($P(RANGE,"^")]"":$P(RANGE,"^",2),1:"DATE"),!,*7 S Y=-1
- S DATE=DATE_"^"_+Y X ^DD("DD") W " ",Y
- Q DATE
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCEVUTL1 1789 printed Mar 13, 2025@20:51:29 Page 2
- RCEVUTL1 ;WASH-ISC@ALTOONA,PA/LDB-Generic Event Utilities ;2/28/95 8:36 AM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- DATE(RANGE) ;Select date range or range of activity
- +1 ;RANGE=$P1 (Prompt for type of range)
- +2 ; $P2 (Prompt for default for beginning of range) NULL is FIRST
- +3 ; $P3 (Prompt for default for end of range) NULL is LAST
- +4 ; $P4 (%DT variable will be set to this type of date)
- +5 ; $P5 (%DT(0) variable will be set to this date constraint)
- +6 NEW %DT,DATE,FDT,X,Y
- BEG ;Select beginnning of range
- +1 SET %DT=$SELECT($PIECE(RANGE,"^",4)]"":$PIECE(RANGE,"^",4),1:"T")
- +2 if $PIECE(RANGE,"^",5)]""
- SET %DT(0)=$PIECE(RANGE,"^",5)
- +3 SET FDT=$SELECT($PIECE(RANGE,"^",2)]"":$$SLH^RCFN01($PIECE(RANGE,"^",2)),1:"FIRST")
- +4 WRITE !,"Enter the beginning "_$SELECT($PIECE(RANGE,"^")]"":$PIECE(RANGE,"^"),1:"DATE")_" : "_FDT_"// "
- READ X:DTIME
- +5 IF '$TEST!(X="^")
- SET Y=-1
- QUIT Y
- +6 IF X="?"
- WRITE !,"Examples of Valid Date: JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057"
- GOTO BEG
- +7 IF X=""
- SET (X,Y)=$PIECE(RANGE,"^",2)
- +8 IF X]""
- DO ^%DT
- if Y=-1
- GOTO BEG
- +9 SET DATE=+Y
- XECUTE ^DD("DD")
- WRITE " ",Y
- +10 ;
- END ;Select ending of range
- +1 SET %DT=$SELECT($PIECE(RANGE,"^",4)]"":$PIECE(RANGE,"^",4),1:"T")
- +2 if $PIECE(RANGE,"^",5)]""
- SET %DT(0)=$PIECE(RANGE,"^",5)
- +3 WRITE !,"Enter the ending "_$SELECT($PIECE(RANGE,"^")]"":$PIECE(RANGE,"^"),1:"DATE")_" : "_$SELECT($PIECE(RANGE,"^",3)]"":$$SLH^RCFN01($PIECE(RANGE,"^",3)),1:"LAST")_"// "
- READ X:DTIME
- +4 IF '$TEST!(X="^")
- SET Y=-1
- QUIT Y
- +5 IF X="?"
- WRITE !,"Examples of Valid Date: JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057"
- GOTO END
- +6 IF X=""
- SET X=$SELECT($PIECE(RANGE,"^",3)]"":$PIECE(RANGE,"^",3),1:"")
- +7 IF X=""
- SET Y=0
- SET DATE=DATE_"^"_Y
- QUIT DATE
- +8 IF X]""
- DO ^%DT
- Begin DoDot:1
- +9 IF Y<DATE
- WRITE !,*7,"Must be equal to or greater than beginning "_$SELECT($PIECE(RANGE,"^")]"":$PIECE(RANGE,"^",2),1:"DATE"),!,*7
- SET Y=-1
- End DoDot:1
- if Y=-1
- GOTO END
- +10 SET DATE=DATE_"^"_+Y
- XECUTE ^DD("DD")
- WRITE " ",Y
- +11 QUIT DATE
- +12 ;
