source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVRPCPT.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1WVRPCPT ;HIOFO/FT-WV PATIENT file (790) RPCs ;6/18/04 13:21
2 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
3 ;
4 ; This routine uses the following IAs:
5 ; #10103 - ^XLFDT calls (supported)
6 ;
7BRTX(DFN,BRTX,BRDD,CRTX,CRDD,WVPDATE) ; Update the patient's treatment needs and
8 ; due dates in WV PATIENT file (790)
9 ; Input: DFN - patient DFN [required]
10 ; BRTX - breast treatment need IEN (790.51) [optional]
11 ; BRDD - breast treatment need offset (e.g., 1Y) [optional]
12 ; CRTX - cervical treament need IEN (790.5) [optional]
13 ; CRDD - cervical treatment need offset (e.g., 90D) [optional]
14 ; WVPDATE - date procedure was performed [optional]
15 ; default is today
16 ; Output: <none>
17 Q:'DFN
18 Q:'$D(^WV(790,DFN,0))
19 S:'$D(BRTX) BRTX=""
20 S:'$D(BRDD) BRDD=""
21 S:'$D(CRTX) CRTX=""
22 S:'$D(CRDD) CRDD=""
23 S:'$G(WVPDATE) WVPDATE=DT
24 N WVDATE,WVFDA
25 S:BRTX]"" WVFDA(790,DFN_",",.18)=BRTX
26 I BRDD]"" D
27 .S WVDATE=$$FMADD(BRDD,WVPDATE)
28 .S:WVDATE>0 WVFDA(790,DFN_",",.19)=WVDATE
29 .Q
30 S:CRTX]"" WVFDA(790,DFN_",",.11)=CRTX
31 I CRDD]"" D
32 .S WVDATE=$$FMADD(CRDD,WVPDATE)
33 .S:WVDATE>0 WVFDA(790,DFN_",",.12)=WVDATE
34 .Q
35 I $D(WVFDA) D FILE^DIE("","WVFDA","WVERR")
36 Q
37 ;
38FMADD(WVDAYS,WVPDT) ; This function adds the date offset indicated to the
39 ; specified date to calculate a future date.
40 ; Input: WVDAYS - date offset (e.g., 90D, 6M, 1Y) [required]
41 ; WVPDT - date of procedure [optional]
42 ; default is today
43 ; Output: FileMan date. Returns null if a FileMan date could not
44 ; be calculated.
45 ;
46 Q:'WVDAYS ""
47 S:'$G(WVPDT) WVPDT=DT
48 N WVARRAY,WVERR,WVLOOP,WVMONTH,WVNEWDT,WVYEAR,X
49 S WVNEWDT=""
50 S X=WVDAYS
51 D DMYCHECK^WVPURP ;check offset value
52 S WVDAYS=X
53 I X=-1 Q WVNEWDT
54 I WVDAYS["D" D
55 .S WVARRAY=$$FMADD^XLFDT(WVPDT,+WVDAYS)
56 .S:WVARRAY>0 WVNEWDT=WVARRAY
57 .Q
58 I WVDAYS["M" D
59 .S WVMONTH=+$E(WVPDT,4,5),WVYEAR=0
60 .F WVLOOP=1:1:+WVDAYS D
61 ..S WVMONTH=WVMONTH+1
62 ..I WVMONTH>12 S WVMONTH=1,WVYEAR=WVYEAR+1
63 ..Q
64 .S WVNEWDT=WVPDT+(+WVYEAR*10000)
65 .S WVMONTH=$S(WVMONTH<10:"0"_WVMONTH,1:WVMONTH)
66 .S WVNEWDT=$E(WVNEWDT,1,3)_WVMONTH_$E(WVNEWDT,6,7)
67 .Q
68 I WVDAYS["Y" S WVNEWDT=WVPDT+(+WVDAYS*10000)
69 Q WVNEWDT
70 ;
Note: See TracBrowser for help on using the repository browser.