- BPSOSU1 ;BHAM ISC/FCS/DRS/FLS/DLF - copied for ECME ;03/07/08 10:34
- ;;1.0;E CLAIMS MGMT ENGINE;**1,7**;JUN 2004;Build 46
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;----------------------------------------------------------------------
- ;Standard Date Functions
- ;----------------------------------------------------------------------
- ;Standard Date PROMPT:
- ;
- ;Parameters:
- ; PROMPT = Text to be displayed before read
- ; DFLT = Default date (internal format)
- ; OPT = 1 - Answer optional 0 - Answer required
- ; SDATE = Minimum date (internal format or NOW and DT)
- ; EDATE = Maximum date (internal format or NOW and DT)
- ; %DT = E - Echo answer R - Require time
- ; S - Seconds returned T - Time allowed but not req
- ; X - Exact date req
- ; TIMEOUT = Number of seconds
- ;
- ;Returns:
- ; <null> = No response <^> - Up-arrow entered
- ; <-1> = Timeout occurred <^^> - Two up-arrows entered
- ; <date> = Internal FM Date
- ;----------------------------------------------------------------------
- ; IHS/SD/lwj 8/5/02 NCPDP 5.1 changes
- ; Subroutine FM3EXT cloned from FM2EXT - routine used to transfer
- ; the dates. Now that NCPDP 5.1 stores the field ID with all the
- ; fields, we needed currently just want to skip transforming the
- ; date for 5.1 type claims
- ;
- ;
- ;----------------------------------------------------------------------
- DATE(PROMPT,DFLT,OPT,SDATE,EDATE,%DT,TIMEOUT) ;EP -
- ;
- N XDATA,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- ;
- Q:$G(PROMPT)="" ""
- ;
- S $P(DIR(0),"^",1)="DA"_$S(OPT=1:"O",1:"")
- S $P(XDATA,":",1)=SDATE
- S $P(XDATA,":",2)=EDATE
- S $P(XDATA,":",3)=%DT
- S $P(DIR(0),"^",2)=XDATA
- S DIR("A")=PROMPT
- S:$G(DFLT)'="" DIR("B")=$$FM2EXT(DFLT)
- S:+$G(TIMEOUT)>0 DIR("T")=TIMEOUT
- D ^DIR
- Q $S($G(DTOUT)=1:-1,$G(DIROUT)=1:"^^",$G(DUOUT)=1:"^",1:Y)
- ;----------------------------------------------------------------------
- ;Convert FileMan Date to External Date Format
- ;
- ;Parameters: Y - FileMan formatted date (YYYMMDD.HHMMSS)
- ;Returns: Y - External date
- ;----------------------------------------------------------------------
- FM2EXT(Y) ;EP
- Q:$G(^DD("DD"))="" ""
- X ^DD("DD")
- Q $S($E(Y,1,3)?3A:Y,1:"")
- ;----------------------------------------------------------------------
- ;
- FM3EXT(Y) ;EP IHS/SD/lwj 8/5/02 clone of FM2EXT- accommodates 5.1 type clms
- Q:$E(Y,1,1)["C" Y
- S Y=Y-17000000
- Q:$G(^DD("DD"))="" ""
- X ^DD("DD")
- Q $S($E(Y,1,3)?3A:Y,1:"")
- ;----------------------------------------------------------------------
- ;
- FM2MDY(Y) ;EP
- Q:Y="" ""
- Q $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
- ;----------------------------------------------------------------------
- ;Convert External Date to FileMan Date Format
- ;
- ;Parameters: X - External date
- ;Returns: Y - FileMan formatted date (YYYMMDD.HHMMSS)
- ;----------------------------------------------------------------------
- EXT2FM(X) ;
- N %DT,Y
- Q:$G(X)="" ""
- D ^%DT
- Q Y
- ;----------------------------------------------------------------------
- ;Returns current Date/Time in FileMan date format
- NOWFM() ;EP
- N %,%H,%I,X
- D NOW^%DTC
- Q %
- NOWEXT() ;EP - External form of $$NOWFM
- N Y S Y=$$NOWFM X ^DD("DD") Q Y
- ;----------------------------------------------------------------------
- ;Takes a FileMan date and adds or subtracts days
- ;
- ;Parameters: X1 - FileMan formatted date
- ; X2 - Number of days (ECME = add, neg = subtract)
- ;Returns: X - Resulting FileMan formatted date
- ;----------------------------------------------------------------------
- CDTFM(X1,X2) ;EP - BPSER*,BPSES02
- N X,%H
- Q:$G(X1)="" ""
- Q:$G(X2)="" ""
- D C^%DTC
- Q X
- ;----------------------------------------------------------------------
- ;Takes a FileMan date and returns 3-digit julian date
- JULDATE(DT) ;
- N X,X1,X2,%H,%T,%Y
- Q:'(DT?7N) ""
- S X2=$E(DT,1,3)_"0101",X1=DT
- D ^%DTC
- S X=X+1
- Q $TR($J(X,3)," ","0")
- ;----------------------------------------------------------------------
- ;
- ;$$DTR(AA,AB,ADEF,BDEF,T) Input Beginning & Ending prompts, return
- ; "Begin date^End date" or 0 if unsuccessful.
- ;$$DTR() is okay - all args are optional
- ;$$DTP(AA,DEF) Input a prompt, return a single date "Internal^External"
- ;$$DTM(AA,DEF) Input a prompt, return month/year "Internal^External"
- ;--------------------------------------------------------------------
- ;
- DTR(AA,AB,ADEF,BDEF,T) ;EP - GET THE DATE RANGE (beginning and ending dates)
- ; IN:
- ; AA = PROMPT for BEGINNING DATE
- ; AB = PROMPT for ENDING DATE
- ; ADEF = DEFAULT date for BEGINNING DATE
- ; BDEF = DEFAULT date for ENDING DATE
- ; T = whether TIME is allowed as entry, and if REQUIRED
- ; (If T="T" then TIME is allowed; is REQ'd if T="R").
- ; OUT:
- ; Beginning Date^Ending Date in 7digit FileMan format
- ; If user enters "^" then out=0
- ;
- NEW %DT,X,Y,U,PROMPT,DEFAULT,BEGDT,ENDDT
- S U="^"
- ;
- DTR1 ; -- Get beginning date
- S %DT="AE"_$G(T)
- I $D(AA) S PROMPT=AA
- E S PROMPT="Enter the Beginning Date"_$S($G(T)]"":" @ Time",1:"")_": "
- S:$D(ADEF) DEFAULT=ADEF
- S BEGDT=$$DATE^BPSOSU1(PROMPT,$G(DEFAULT),1,1000101,3991231,%DT,$G(DTIME))
- I BEGDT<1 QUIT 0
- ;
- WRITE !
- S %DT="AE"_$G(T)
- I $D(AB) S PROMPT=AB
- E S PROMPT="Enter the Ending Date"_$S($G(T)]"":" @ Time",1:"")_": "
- S:$D(BDEF) DEFAULT=BDEF
- S ENDDT=$$DATE^BPSOSU1(PROMPT,$G(DEFAULT),1,BEGDT,3991231,%DT,$G(DTIME))
- I ENDDT["^" Q 0 ;user wants out if "^"
- ; -- Ensure END date is not earlier than BEG date
- I ENDDT<BEGDT WRITE $C(7),!!,"Ending date must not be less than beginning date!",!! HANG 2 GOTO DTR1
- QUIT BEGDT_U_ENDDT
- ;--------------------------------------------------------------------
- ;
- ;
- DTP(AA,DEF) ;EP - *** GET A SINGLE PAST DATE, TIME NOT ALLOWED ***
- ;
- ; IN: AA = PROMPT you want displayed to user
- ; DEF = DEFAULT date
- ; OUT: FileMan Date^readable Date
- ; If user enters "^" then OUT=0
- ;
- NEW %DT,Y,DATE
- S:'$D(U) U="^"
- I '$D(DT)#2 DO DT^DICRW ;get today's date
- S U="^"
- S %DT="AEPX" ;ask, echo, past dates assumed, exact date reqd
- S %DT("A")=$S($D(AA):AA,1:"What DATE: ")
- S:$D(DEF) %DT("B")=DEF
- DO ^%DT KILL %DT
- ; -- Q if no data
- I Y<1 QUIT 0 ;quit if date was invalid
- I $D(DTOUT) QUIT 0 ;quit if timeout occurred
- ; -- Define dates
- ; DATE("Y") is FM format date; DATE is MON DD,YEAR format.
- S DATE("Y")=Y XECUTE ^DD("DD") S DATE=Y
- QUIT DATE("Y")_U_DATE
- ;--------------------------------------------------------------------
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSU1 6719 printed Jan 18, 2025@02:53:22 Page 2
- BPSOSU1 ;BHAM ISC/FCS/DRS/FLS/DLF - copied for ECME ;03/07/08 10:34
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**1,7**;JUN 2004;Build 46
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;----------------------------------------------------------------------
- +5 ;Standard Date Functions
- +6 ;----------------------------------------------------------------------
- +7 ;Standard Date PROMPT:
- +8 ;
- +9 ;Parameters:
- +10 ; PROMPT = Text to be displayed before read
- +11 ; DFLT = Default date (internal format)
- +12 ; OPT = 1 - Answer optional 0 - Answer required
- +13 ; SDATE = Minimum date (internal format or NOW and DT)
- +14 ; EDATE = Maximum date (internal format or NOW and DT)
- +15 ; %DT = E - Echo answer R - Require time
- +16 ; S - Seconds returned T - Time allowed but not req
- +17 ; X - Exact date req
- +18 ; TIMEOUT = Number of seconds
- +19 ;
- +20 ;Returns:
- +21 ; <null> = No response <^> - Up-arrow entered
- +22 ; <-1> = Timeout occurred <^^> - Two up-arrows entered
- +23 ; <date> = Internal FM Date
- +24 ;----------------------------------------------------------------------
- +25 ; IHS/SD/lwj 8/5/02 NCPDP 5.1 changes
- +26 ; Subroutine FM3EXT cloned from FM2EXT - routine used to transfer
- +27 ; the dates. Now that NCPDP 5.1 stores the field ID with all the
- +28 ; fields, we needed currently just want to skip transforming the
- +29 ; date for 5.1 type claims
- +30 ;
- +31 ;
- +32 ;----------------------------------------------------------------------
- DATE(PROMPT,DFLT,OPT,SDATE,EDATE,%DT,TIMEOUT) ;EP -
- +1 ;
- +2 NEW XDATA,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +3 ;
- +4 if $GET(PROMPT)=""
- QUIT ""
- +5 ;
- +6 SET $PIECE(DIR(0),"^",1)="DA"_$SELECT(OPT=1:"O",1:"")
- +7 SET $PIECE(XDATA,":",1)=SDATE
- +8 SET $PIECE(XDATA,":",2)=EDATE
- +9 SET $PIECE(XDATA,":",3)=%DT
- +10 SET $PIECE(DIR(0),"^",2)=XDATA
- +11 SET DIR("A")=PROMPT
- +12 if $GET(DFLT)'=""
- SET DIR("B")=$$FM2EXT(DFLT)
- +13 if +$GET(TIMEOUT)>0
- SET DIR("T")=TIMEOUT
- +14 DO ^DIR
- +15 QUIT $SELECT($GET(DTOUT)=1:-1,$GET(DIROUT)=1:"^^",$GET(DUOUT)=1:"^",1:Y)
- +16 ;----------------------------------------------------------------------
- +17 ;Convert FileMan Date to External Date Format
- +18 ;
- +19 ;Parameters: Y - FileMan formatted date (YYYMMDD.HHMMSS)
- +20 ;Returns: Y - External date
- +21 ;----------------------------------------------------------------------
- FM2EXT(Y) ;EP
- +1 if $GET(^DD("DD"))=""
- QUIT ""
- +2 XECUTE ^DD("DD")
- +3 QUIT $SELECT($EXTRACT(Y,1,3)?3A:Y,1:"")
- +4 ;----------------------------------------------------------------------
- +5 ;
- FM3EXT(Y) ;EP IHS/SD/lwj 8/5/02 clone of FM2EXT- accommodates 5.1 type clms
- +1 if $EXTRACT(Y,1,1)["C"
- QUIT Y
- +2 SET Y=Y-17000000
- +3 if $GET(^DD("DD"))=""
- QUIT ""
- +4 XECUTE ^DD("DD")
- +5 QUIT $SELECT($EXTRACT(Y,1,3)?3A:Y,1:"")
- +6 ;----------------------------------------------------------------------
- +7 ;
- FM2MDY(Y) ;EP
- +1 if Y=""
- QUIT ""
- +2 QUIT $EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
- +3 ;----------------------------------------------------------------------
- +4 ;Convert External Date to FileMan Date Format
- +5 ;
- +6 ;Parameters: X - External date
- +7 ;Returns: Y - FileMan formatted date (YYYMMDD.HHMMSS)
- +8 ;----------------------------------------------------------------------
- EXT2FM(X) ;
- +1 NEW %DT,Y
- +2 if $GET(X)=""
- QUIT ""
- +3 DO ^%DT
- +4 QUIT Y
- +5 ;----------------------------------------------------------------------
- +6 ;Returns current Date/Time in FileMan date format
- NOWFM() ;EP
- +1 NEW %,%H,%I,X
- +2 DO NOW^%DTC
- +3 QUIT %
- NOWEXT() ;EP - External form of $$NOWFM
- +1 NEW Y
- SET Y=$$NOWFM
- XECUTE ^DD("DD")
- QUIT Y
- +2 ;----------------------------------------------------------------------
- +3 ;Takes a FileMan date and adds or subtracts days
- +4 ;
- +5 ;Parameters: X1 - FileMan formatted date
- +6 ; X2 - Number of days (ECME = add, neg = subtract)
- +7 ;Returns: X - Resulting FileMan formatted date
- +8 ;----------------------------------------------------------------------
- CDTFM(X1,X2) ;EP - BPSER*,BPSES02
- +1 NEW X,%H
- +2 if $GET(X1)=""
- QUIT ""
- +3 if $GET(X2)=""
- QUIT ""
- +4 DO C^%DTC
- +5 QUIT X
- +6 ;----------------------------------------------------------------------
- +7 ;Takes a FileMan date and returns 3-digit julian date
- JULDATE(DT) ;
- +1 NEW X,X1,X2,%H,%T,%Y
- +2 if '(DT?7N)
- QUIT ""
- +3 SET X2=$EXTRACT(DT,1,3)_"0101"
- SET X1=DT
- +4 DO ^%DTC
- +5 SET X=X+1
- +6 QUIT $TRANSLATE($JUSTIFY(X,3)," ","0")
- +7 ;----------------------------------------------------------------------
- +8 ;
- +9 ;$$DTR(AA,AB,ADEF,BDEF,T) Input Beginning & Ending prompts, return
- +10 ; "Begin date^End date" or 0 if unsuccessful.
- +11 ;$$DTR() is okay - all args are optional
- +12 ;$$DTP(AA,DEF) Input a prompt, return a single date "Internal^External"
- +13 ;$$DTM(AA,DEF) Input a prompt, return month/year "Internal^External"
- +14 ;--------------------------------------------------------------------
- +15 ;
- DTR(AA,AB,ADEF,BDEF,T) ;EP - GET THE DATE RANGE (beginning and ending dates)
- +1 ; IN:
- +2 ; AA = PROMPT for BEGINNING DATE
- +3 ; AB = PROMPT for ENDING DATE
- +4 ; ADEF = DEFAULT date for BEGINNING DATE
- +5 ; BDEF = DEFAULT date for ENDING DATE
- +6 ; T = whether TIME is allowed as entry, and if REQUIRED
- +7 ; (If T="T" then TIME is allowed; is REQ'd if T="R").
- +8 ; OUT:
- +9 ; Beginning Date^Ending Date in 7digit FileMan format
- +10 ; If user enters "^" then out=0
- +11 ;
- +12 NEW %DT,X,Y,U,PROMPT,DEFAULT,BEGDT,ENDDT
- +13 SET U="^"
- +14 ;
- DTR1 ; -- Get beginning date
- +1 SET %DT="AE"_$GET(T)
- +2 IF $DATA(AA)
- SET PROMPT=AA
- +3 IF '$TEST
- SET PROMPT="Enter the Beginning Date"_$SELECT($GET(T)]"":" @ Time",1:"")_": "
- +4 if $DATA(ADEF)
- SET DEFAULT=ADEF
- +5 SET BEGDT=$$DATE^BPSOSU1(PROMPT,$GET(DEFAULT),1,1000101,3991231,%DT,$GET(DTIME))
- +6 IF BEGDT<1
- QUIT 0
- +7 ;
- +8 WRITE !
- +9 SET %DT="AE"_$GET(T)
- +10 IF $DATA(AB)
- SET PROMPT=AB
- +11 IF '$TEST
- SET PROMPT="Enter the Ending Date"_$SELECT($GET(T)]"":" @ Time",1:"")_": "
- +12 if $DATA(BDEF)
- SET DEFAULT=BDEF
- +13 SET ENDDT=$$DATE^BPSOSU1(PROMPT,$GET(DEFAULT),1,BEGDT,3991231,%DT,$GET(DTIME))
- +14 ;user wants out if "^"
- IF ENDDT["^"
- QUIT 0
- +15 ; -- Ensure END date is not earlier than BEG date
- +16 IF ENDDT<BEGDT
- WRITE $CHAR(7),!!,"Ending date must not be less than beginning date!",!!
- HANG 2
- GOTO DTR1
- +17 QUIT BEGDT_U_ENDDT
- +18 ;--------------------------------------------------------------------
- +19 ;
- +20 ;
- DTP(AA,DEF) ;EP - *** GET A SINGLE PAST DATE, TIME NOT ALLOWED ***
- +1 ;
- +2 ; IN: AA = PROMPT you want displayed to user
- +3 ; DEF = DEFAULT date
- +4 ; OUT: FileMan Date^readable Date
- +5 ; If user enters "^" then OUT=0
- +6 ;
- +7 NEW %DT,Y,DATE
- +8 if '$DATA(U)
- SET U="^"
- +9 ;get today's date
- IF '$DATA(DT)#2
- DO DT^DICRW
- +10 SET U="^"
- +11 ;ask, echo, past dates assumed, exact date reqd
- SET %DT="AEPX"
- +12 SET %DT("A")=$SELECT($DATA(AA):AA,1:"What DATE: ")
- +13 if $DATA(DEF)
- SET %DT("B")=DEF
- +14 DO ^%DT
- KILL %DT
- +15 ; -- Q if no data
- +16 ;quit if date was invalid
- IF Y<1
- QUIT 0
- +17 ;quit if timeout occurred
- IF $DATA(DTOUT)
- QUIT 0
- +18 ; -- Define dates
- +19 ; DATE("Y") is FM format date; DATE is MON DD,YEAR format.
- +20 SET DATE("Y")=Y
- XECUTE ^DD("DD")
- SET DATE=Y
- +21 QUIT DATE("Y")_U_DATE
- +22 ;--------------------------------------------------------------------