source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEUT1.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 4.3 KB
Line 
1PXRMEUT1 ; SLC/PKR - General extract utilities ;08/09/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;=================================================
4DCONV(DATE,LBBDT,LBEDT) ;Convert dates to actual values.
5 I DATE=0 Q DATE
6 N PXRMDATE
7 S PXRMDATE=$S(DATE["BDT":LBBDT,1:LBEDT)
8 S DATE=$$STRREP^PXRMUTIL(DATE,"BDT","T")
9 Q $$CTFMD^PXRMDATE(DATE)
10 ;
11 ;=================================================
12DAYSIM(FMDATE) ;Given a FileMan date return the number of days in the month.
13 N MONTH
14 S MONTH=$E(FMDATE,4,5)
15 S DAYS=$S(MONTH="01":31,MONTH="02":28,MONTH="03":31,MONTH="04":30,MONTH="05":31,MONTH="06":30,MONTH="07":31,MONTH="08":31,MONTH="09":30,MONTH="10":31,MONTH="11":30,MONTH="12":31,1:"")
16 I MONTH="02" D
17 . N LYEAR,YEAR
18 . S YEAR=$E(FMDATE,1,3)+1700
19 . S LYEAR=$S((YEAR#4=0)&(YEAR#100'=0):1,YEAR#400=0:1,1:0)
20 . I LYEAR S DAYS=29
21 Q DAYS
22 ;
23 ;=================================================
24DOCDATES(RULESET,LBBDT,LBEDT,NL,OUTPUT) ;
25 N FINDPA,FRACT,FRDATA,FRDATES,FRIEN,FRLST,FRLIEN,FROLST,FROUT,FRPAT
26 N FRPERM,FRSTRT,FRTIEN,FRTYP,FSEQ,PXRMDATE,PXRMFVPL
27 N RRIEN,RSDATA,RSDATES,RBDT,REDT,SEQ,SUB
28 ;Build the variable pointer list.
29 D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
30 S SEQ="",NL=0
31 F S SEQ=$O(^PXRM(810.4,RULESET,30,"B",SEQ)) Q:'SEQ D
32 . S SUB=$O(^PXRM(810.4,RULESET,30,"B",SEQ,"")) Q:'SUB
33 . S RSDATA=$G(^PXRM(810.4,RULESET,30,SUB,0)) Q:RSDATA=""
34 . S RSDATES=$G(^PXRM(810.4,RULESET,30,SUB,1))
35 .;Finding rule ien.
36 . S FRIEN=$P(RSDATA,U,2) Q:'FRIEN
37 .;Check if entry is a finding rule (not a set or reminder rule)
38 . S FRDATA=$G(^PXRM(810.4,FRIEN,0)),FRTYP=$P(FRDATA,U,3) Q:FRTYP=3
39 . S FRDATES=$P(FRDATA,U,4,5)
40 .;Get term IEN for finding rule
41 . I FRTYP=1 S FRTIEN=$P(FRDATA,U,7) Q:'FRTIEN
42 .;Get Reminder definition IEN for Reminder rule
43 . I FRTYP=2 S RRIEN=$P(FRDATA,U,10) Q:'RRIEN
44 .;Determine RBDT and REDT
45 . D RDATES(RSDATES,FRDATES,LBBDT,LBEDT,.RBDT,.REDT)
46 . S PXRMDATE=LBEDT
47 . S $P(FINDPA(0),U,8)=RBDT,$P(FINDPA(0),U,11)=REDT
48 . S NL=NL+1,OUTPUT(NL)=""
49 . S NL=NL+1,OUTPUT(NL)="SEQUENCE "_SEQ_" "_$P(FRDATA,U,1)
50 .;Term finding rules
51 . I FRTYP=1 D TERM(FRTIEN,.FINDPA,.PXRMFVPL,.NL,.OUTPUT)
52 .;Reminder Definition List Rule
53 . I FRTYP=2 D REM(RRIEN,.FINDPA,.PXRMFVPL,.NL,.OUTPUT)
54 Q
55 ;
56 ;=================================================
57FMULPRT(DEFARR,FINDPA,PXRMFVPL,NL,OUTPUT) ;Print the finding multiple
58 ;information.
59 N BDT,EDT,FNAME,FTYPE,IND,NOCC,PFINDPA,TFINDPA,VPTR
60 S IND=0
61 F S IND=+$O(DEFARR(20,IND)) Q:IND=0 D
62 . S VPTR=$P(DEFARR(20,IND,0),U,1)
63 . S FNAME=$$ENTRYNAM^PXRMPTD2(VPTR)
64 . S FTYPE=$$FTYPE^PXRMPTD2(VPTR,1)
65 . S NL=NL+1,OUTPUT(NL)=" FINDING "_IND_"-"_FTYPE_"."_FNAME
66 . K PFINDPA,TFINDPA
67 . M TFINDPA=DEFARR(20,IND)
68 .;Set the finding parameters.
69 . D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
70 . D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
71 . S NL=NL+1,OUTPUT(NL)=" Beginning Date/Time: "_$$FMTE^XLFDT(BDT,"5Z")
72 . S NL=NL+1,OUTPUT(NL)=" Ending Date/Time: "_$$FMTE^XLFDT(EDT,"5Z")
73 Q
74 ;
75 ;=================================================
76RDATES(RSDATES,FRDATES,LBBDT,LBEDT,RBDT,REDT) ;Determine the beginning and
77 ;ending dates.
78 ;Date precedence: LIST BUILD < RULE SET < FINDING RULE < TERM/REMINDER
79 S RBDT=$P(FRDATES,U,1),REDT=$P(FRDATES,U,2)
80 I RBDT="",REDT="" S RBDT=$P(RSDATES,U,1),REDT=$P(RSDATES,U,2)
81 I RBDT="",REDT="" S RBDT=LBBDT,REDT=LBEDT
82 I RBDT="" S RBDT=0
83 I REDT="" S REDT=LBEDT
84 I REDT=0 S REDT=$$DT^XLFDT
85 ;Convert RBDT and REDT to FileMan dates.
86 S RBDT=$$DCONV(RBDT,LBBDT,LBEDT)
87 S REDT=$$DCONV(REDT,LBBDT,LBEDT)
88 ;If the month is missing use January for the beginning date and
89 ;December for the ending date.
90 I $E(RBDT,4,5)="00" S RBDT=$E(RBDT,1,3)_"01"_$E(RBDT,6,7)
91 I $E(REDT,4,5)="00" S REDT=$E(REDT,1,3)_"12"_$E(REDT,6,7)
92 ;If the day is missing use the first for beginning date and the end
93 ;of the month for ending date.
94 I $E(RBDT,6,7)="00" S RBDT=$E(RBDT,1,5)_"01"
95 I $E(REDT,6,7)="00" S REDT=$E(REDT,1,5)_$$DAYSIM(REDT)
96 Q
97 ;
98 ;=================================================
99REM(IEN,FINDPA,PXRMFVPL,NL,OUTPUT) ;
100 N DEFARR
101 D DEF^PXRMLDR(IEN,.DEFARR)
102 S NL=NL+1,OUTPUT(NL)=" REMINDER DEFINITION "_$P(DEFARR(0),U,1)
103 D FMULPRT(.DEFARR,.FINDPA,.PXRMFVPL,.NL,.OUTPUT)
104 Q
105 ;
106 ;=================================================
107TERM(IEN,FINDPA,PXRMFVPL,NL,OUTPUT) ;
108 N TERMARR
109 D TERM^PXRMLDR(IEN,.TERMARR)
110 S NL=NL+1,OUTPUT(NL)=" TERM "_$P(TERMARR(0),U,1)
111 D FMULPRT(.TERMARR,.FINDPA,.PXRMFVPL,.NL,.OUTPUT)
112 Q
113 ;
Note: See TracBrowser for help on using the repository browser.