source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSU1.m@ 1470

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1BPSOSU1 ;BHAM ISC/FCS/DRS/FLS/DLF - copied for ECME ;06/01/2004
2 ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
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 ;----------------------------------------------------------------------
33DATE(PROMPT,DFLT,OPT,SDATE,EDATE,%DT,TIMEOUT) ;EP -
34 ;
35 N XDATA,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
36 ;
37 Q:$G(PROMPT)="" ""
38 ;
39 S $P(DIR(0),"^",1)="DA"_$S(OPT=1:"O",1:"")
40 S $P(XDATA,":",1)=SDATE
41 S $P(XDATA,":",2)=EDATE
42 S $P(XDATA,":",3)=%DT
43 S $P(DIR(0),"^",2)=XDATA
44 S DIR("A")=PROMPT
45 S:$G(DFLT)'="" DIR("B")=$$FM2EXT(DFLT)
46 S:+$G(TIMEOUT)>0 DIR("T")=TIMEOUT
47 D ^DIR
48 Q $S($G(DTOUT)=1:-1,$G(DIROUT)=1:"^^",$G(DUOUT)=1:"^",1:Y)
49 ;----------------------------------------------------------------------
50 ;Convert FileMan Date to External Date Format
51 ;
52 ;Parameters: Y - FileMan formatted date (YYYMMDD.HHMMSS)
53 ;Returns: Y - External date
54 ;----------------------------------------------------------------------
55FM2EXT(Y) ;EP
56 Q:$G(^DD("DD"))="" ""
57 X ^DD("DD")
58 Q $S($E(Y,1,3)?3A:Y,1:"")
59 ;----------------------------------------------------------------------
60 ;
61FM3EXT(Y) ;EP IHS/SD/lwj 8/5/02 clone of FM2EXT- accommodates 5.1 type clms
62 Q:$E(Y,1,1)["C" Y
63 S Y=Y-17000000
64 Q:$G(^DD("DD"))="" ""
65 X ^DD("DD")
66 Q $S($E(Y,1,3)?3A:Y,1:"")
67 ;----------------------------------------------------------------------
68 ;
69FM2MDY(Y) ;EP
70 Q:Y="" ""
71 Q $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
72 ;----------------------------------------------------------------------
73 ;Convert External Date to FileMan Date Format
74 ;
75 ;Parameters: X - External date
76 ;Returns: Y - FileMan formatted date (YYYMMDD.HHMMSS)
77 ;----------------------------------------------------------------------
78EXT2FM(X) ;
79 N %DT,Y
80 Q:$G(X)="" ""
81 D ^%DT
82 Q Y
83 ;----------------------------------------------------------------------
84 ;Returns current Date/Time in FileMan date format
85NOWFM() ;EP
86 N %,%H,%I,X
87 D NOW^%DTC
88 Q %
89NOWEXT() ;EP - External form of $$NOWFM
90 N Y S Y=$$NOWFM X ^DD("DD") Q Y
91 ;----------------------------------------------------------------------
92 ;Takes a FileMan date and adds or subtracts days
93 ;
94 ;Parameters: X1 - FileMan formatted date
95 ; X2 - Number of days (ECME = add, neg = subtract)
96 ;Returns: X - Resulting FileMan formatted date
97 ;----------------------------------------------------------------------
98CDTFM(X1,X2) ;EP - BPSER*,BPSES02
99 N X,%H
100 Q:$G(X1)="" ""
101 Q:$G(X2)="" ""
102 D C^%DTC
103 Q X
104 ;----------------------------------------------------------------------
105 ;Takes a FileMan date and returns 3-digit julian date
106JULDATE(DT) ;
107 N X,X1,X2,%H,%T,%Y
108 Q:'(DT?7N) ""
109 S X2=$E(DT,1,3)_"0101",X1=DT
110 D ^%DTC
111 S X=X+1
112 Q $TR($J(X,3)," ","0")
113 ;----------------------------------------------------------------------
114 ;
115 ;$$DTR(AA,AB,ADEF,BDEF,T) Input Beginning & Ending prompts, return
116 ; "Begin date^End date" or 0 if unsuccessful.
117 ;$$DTR() is okay - all args are optional
118 ;$$DTP(AA,DEF) Input a prompt, return a single date "Internal^External"
119 ;$$DTM(AA,DEF) Input a prompt, return month/year "Internal^External"
120 ;--------------------------------------------------------------------
121 ;
122DTR(AA,AB,ADEF,BDEF,T) ;EP - GET THE DATE RANGE (beginning and ending dates)
123 ; IN:
124 ; AA = PROMPT for BEGINNING DATE
125 ; AB = PROMPT for ENDING DATE
126 ; ADEF = DEFAULT date for BEGINNING DATE
127 ; BDEF = DEFAULT date for ENDING DATE
128 ; T = whether TIME is allowed as entry, and if REQUIRED
129 ; (If T="T" then TIME is allowed; is REQ'd if T="R").
130 ; OUT:
131 ; Beginning Date^Ending Date in 7digit FileMan format
132 ; If user enters "^" then out=0
133 ;
134 NEW %DT,X,Y,U,PROMPT,DEFAULT,BEGDT,ENDDT
135 S U="^"
136 ;
137DTR1 ; -- Get beginning date
138 S %DT="AE"_$G(T)
139 I $D(AA) S PROMPT=AA
140 E S PROMPT="Enter the Beginning Date"_$S($G(T)]"":" @ Time",1:"")_": "
141 S:$D(ADEF) DEFAULT=ADEF
142 S BEGDT=$$DATE^BPSOSU1(PROMPT,$G(DEFAULT),1,1000101,3991231,%DT,$G(DTIME))
143 I BEGDT<1 QUIT 0
144 ;
145 WRITE !
146 S %DT="AE"_$G(T)
147 I $D(AB) S PROMPT=AB
148 E S PROMPT="Enter the Ending Date"_$S($G(T)]"":" @ Time",1:"")_": "
149 S:$D(BDEF) DEFAULT=BDEF
150 S ENDDT=$$DATE^BPSOSU1(PROMPT,$G(DEFAULT),1,BEGDT,3991231,%DT,$G(DTIME))
151 I ENDDT["^" Q 0 ;user wants out if "^"
152 ; -- Ensure END date is not earlier than BEG date
153 I ENDDT<BEGDT WRITE $C(7),!!,"Ending date must not be less than beginning date!",!! HANG 2 GOTO DTR1
154 QUIT BEGDT_U_ENDDT
155 ;--------------------------------------------------------------------
156 ;
157 ;
158DTP(AA,DEF) ;EP - *** GET A SINGLE PAST DATE, TIME NOT ALLOWED ***
159 ;
160 ; IN: AA = PROMPT you want displayed to user
161 ; DEF = DEFAULT date
162 ; OUT: FileMan Date^readable Date
163 ; If user enters "^" then OUT=0
164 ;
165 NEW %DT,Y,DATE
166 S:'$D(U) U="^"
167 I '$D(DT)#2 DO DT^DICRW ;get today's date
168 S U="^"
169 S %DT="AEPX" ;ask, echo, past dates assumed, exact date reqd
170 S %DT("A")=$S($D(AA):AA,1:"What DATE: ")
171 S:$D(DEF) %DT("B")=DEF
172 DO ^%DT KILL %DT
173 ; -- Q if no data
174 I Y<1 QUIT 0 ;quit if date was invalid
175 I $D(DTOUT) QUIT 0 ;quit if timeout occurred
176 ; -- Define dates
177 ; DATE("Y") is FM format date; DATE is MON DD,YEAR format.
178 S DATE("Y")=Y XECUTE ^DD("DD") S DATE=Y
179 QUIT DATE("Y")_U_DATE
180 ;--------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.