| 1 | WVRPCPT ;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 | ;
|
|---|
| 7 | BRTX(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 | ;
|
|---|
| 38 | FMADD(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 | ;
|
|---|
