Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSOSU1

BPSOSU1.m

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