source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEUT1.m@ 619

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

initial load of WorldVistAEHR
File size: 5.8 KB
RevLine 
[613]1PXRMEUT1 ; SLC/PKR - General extract utilities ;05/08/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;=================================================
4CLDATES ;Cleanup entries in ^TMP("PXRMDDOC",$J) before making date checks.
5 ;For drug findings consolidate PS(55, PS(55NVA, and PSRX( back to
6 ;PSDRUG(.
7 N FI,FIND0,ITEM,GLOBAL,LIST
8 S FIND0=""
9 F S FIND0=$O(^TMP("PXRMDDOC",$J,FIND0)) Q:FIND0="" D
10 . S FI=$P(FIND0,U,1)
11 . S GLOBAL=$P(FI,";",2)
12 . I GLOBAL'["PS" Q
13 . S GLOBAL="PSDRUG("
14 . S ITEM=$P(FI,";",1)
15 . S FI=ITEM_";"_GLOBAL_U_$P(FIND0,U,2,11)
16 . S LIST(FIND0)=FI
17 ;
18 S FIND0=""
19 F S FIND0=$O(LIST(FIND0)) Q:FIND0="" D
20 . S FI=LIST(FIND0)
21 . S ^TMP("PXRMDDOC",$J,FI)=^TMP("PXRMDDOC",$J,FIND0)
22 . K ^TMP("PXRMDDOC",$J,FIND0)
23 Q
24 ;
25 ;=================================================
26DAYSIM(FMDATE) ;Given a FileMan date return the number of days in the month.
27 N MONTH
28 S MONTH=$E(FMDATE,4,5)
29 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:"")
30 I MONTH="02" D
31 . N LYEAR,YEAR
32 . S YEAR=$E(FMDATE,1,3)+1700
33 . S LYEAR=$S((YEAR#4=0)&(YEAR#100'=0):1,YEAR#400=0:1,1:0)
34 . I LYEAR S DAYS=29
35 Q DAYS
36 ;
37 ;=================================================
38DCONV(DATE,LBBDT,LBEDT) ;Convert dates to actual values.
39 I DATE=0 Q DATE
40 N PXRMDATE
41 S PXRMDATE=$S(DATE["BDT":LBBDT,1:LBEDT)
42 S DATE=$$STRREP^PXRMUTIL(DATE,"BDT","T")
43 Q $$CTFMD^PXRMDATE(DATE)
44 ;
45 ;=================================================
46DOCDATES(RULESET,LBBDT,LBEDT,NL,OUTPUT) ;
47 N EM,FRACT,FRDATA,FRDATES,FRIEN,FRLST,FRLIEN,FROLST,FROUT,FRPAT
48 N FRPERM,FRSTRT,FRTIEN,FRTYP,FSEQ,OPER,PXRMFVPL
49 N RRIEN,RSDATA,RSDATES,RBDT,REDT,SEQ,SUB
50 I $G(PXRMDDOC)=2 D CLDATES
51 ;Build the variable pointer list.
52 D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
53 S SEQ="",NL=0
54 F S SEQ=$O(^PXRM(810.4,RULESET,30,"B",SEQ)) Q:'SEQ D
55 . S SUB=$O(^PXRM(810.4,RULESET,30,"B",SEQ,"")) Q:'SUB
56 . S RSDATA=$G(^PXRM(810.4,RULESET,30,SUB,0)) Q:RSDATA=""
57 . S OPER=$P(RSDATA,U,3)
58 . S OPER=$$EXTERNAL^DILFD(810.41,.03,"",OPER,.EM)
59 . S RSDATES=$G(^PXRM(810.4,RULESET,30,SUB,1))
60 .;Finding rule ien.
61 . S FRIEN=$P(RSDATA,U,2) Q:'FRIEN
62 .;Check if entry is a finding rule (not a set or reminder rule)
63 . S FRDATA=$G(^PXRM(810.4,FRIEN,0)),FRTYP=$P(FRDATA,U,3) Q:FRTYP=3
64 . S FRDATES=$P(FRDATA,U,4,5)
65 .;Get term IEN for finding rule
66 . I FRTYP=1 S FRTIEN=$P(FRDATA,U,7) Q:'FRTIEN
67 .;Get Reminder definition IEN for Reminder rule
68 . I FRTYP=2 S RRIEN=$P(FRDATA,U,10) Q:'RRIEN
69 .;Determine RBDT and REDT
70 . D RDATES(RSDATES,FRDATES,LBBDT,LBEDT,.RBDT,.REDT)
71 . S NL=NL+1,OUTPUT(NL)=""
72 . S NL=NL+1,OUTPUT(NL)="SEQUENCE "_SEQ_" "_$P(FRDATA,U,1)
73 . S NL=NL+1,OUTPUT(NL)=" Operation: "_OPER
74 .;Term finding rules
75 . I FRTYP=1 D TERM(FRTIEN,LBBDT,LBEDT,RBDT,REDT,.PXRMFVPL,.NL,.OUTPUT)
76 .;Reminder Definition List Rule
77 . I FRTYP=2 D REM(RRIEN,LBBDT,LBEDT,RBDT,REDT,.PXRMFVPL,.NL,.OUTPUT)
78 Q
79 ;
80 ;=================================================
81FMULPRT(FARR,PXRMFVPL,NL,OUTPUT) ;Print the finding multiple
82 ;information.
83 ;Q
84 N BDT,EDT,DERROR,FNAME,FTYPE,IND,NOCC,TBDT,TEDT,TEMP,VPTR
85 S IND=0
86 F S IND=+$O(FARR(20,IND)) Q:IND=0 D
87 . S VPTR=$P(FARR(20,IND,0),U,1)
88 . S FNAME=$$ENTRYNAM^PXRMPTD2(VPTR)
89 . S FTYPE=$$FTYPE^PXRMPTD2(VPTR,1)
90 . S NL=NL+1,OUTPUT(NL)=" FINDING "_IND_"-"_FTYPE_"."_FNAME
91 .;Set the finding parameters.
92 . D SSPAR^PXRMUTIL(FARR(20,IND,0),.NOCC,.BDT,.EDT)
93 . S NL=NL+1,OUTPUT(NL)=" Beginning Date/Time: "_$$FMTE^XLFDT(BDT,"5Z")
94 . S NL=NL+1,OUTPUT(NL)=" Ending Date/Time: "_$$FMTE^XLFDT(EDT,"5Z")
95 . I $G(PXRMDDOC)'=2 Q
96 . S DERROR=0
97 . S TEMP=$G(^TMP("PXRMDDOC",$J,$P(FARR(20,IND,0),U,1,11)))
98 .;If TEMP is null then no evaluation was required and the check
99 .;cannot be made
100 . I TEMP="" Q
101 . I $P(TEMP,U,1)'=BDT D
102 .. S DERROR=1
103 .. S NL=NL+1,OUTPUT(NL)=" There is a consistency problem with the beginning date!"
104 .. S NL=NL+1,OUTPUT(NL)=" Date used to build the list was: "_$$FMTE^XLFDT($P(TEMP,U,1),"5Z")
105 . I $P(TEMP,U,2)'=EDT D
106 .. S DERROR=1
107 .. S NL=NL+1,OUTPUT(NL)=" There is a consistency problem with the ending date!"
108 .. S NL=NL+1,OUTPUT(NL)=" Date used to build the list was: "_$$FMTE^XLFDT($P(TEMP,U,2),"5Z")
109 . I DERROR D
110 .. S NL=NL+1,OUTPUT(NL)=" Please notify the developers."
111 .. ;S NL=NL+1,OUTPUT(NL)=" Please enter a Remedy ticket."
112 .. S NL=NL+1,OUTPUT(NL)=" "
113 Q
114 ;
115 ;=================================================
116RDATES(RSDATES,FRDATES,LBBDT,LBEDT,RBDT,REDT) ;Determine the beginning and
117 ;ending dates.
118 ;Date precedence: LIST BUILD < RULE SET < FINDING RULE < TERM/REMINDER
119 S RBDT=$P(FRDATES,U,1),REDT=$P(FRDATES,U,2)
120 I RBDT="",REDT="" S RBDT=$P(RSDATES,U,1),REDT=$P(RSDATES,U,2)
121 I RBDT="",REDT="" S RBDT=LBBDT,REDT=LBEDT
122 I RBDT="" S RBDT=0
123 I REDT="" S REDT=LBEDT
124 I REDT=0 S REDT=DT
125 ;Convert RBDT and REDT to FileMan dates.
126 S RBDT=$$DCONV(RBDT,LBBDT,LBEDT)
127 S REDT=$$DCONV(REDT,LBBDT,LBEDT)
128 ;If the month is missing use January for the beginning date and
129 ;December for the ending date.
130 I $E(RBDT,4,5)="00" S RBDT=$E(RBDT,1,3)_"01"_$E(RBDT,6,7)
131 I $E(REDT,4,5)="00" S REDT=$E(REDT,1,3)_"12"_$E(REDT,6,7)
132 ;If the day is missing use the first for beginning date and the end
133 ;of the month for ending date.
134 I $E(RBDT,6,7)="00" S RBDT=$E(RBDT,1,5)_"01"
135 I $E(REDT,6,7)="00" S REDT=$E(REDT,1,5)_$$DAYSIM(REDT)
136 Q
137 ;
138 ;=================================================
139REM(IEN,LBBDT,LBEDT,RBDT,REDT,PXRMFVPL,NL,OUTPUT) ;
140 N DEFARR
141 D DEF^PXRMLDR(IEN,.DEFARR)
142 D DATES^PXRMRUL1(LBBDT,LBEDT,RBDT,REDT,.DEFARR)
143 S NL=NL+1,OUTPUT(NL)=" REMINDER DEFINITION "_$P(DEFARR(0),U,1)
144 D FMULPRT(.DEFARR,.PXRMFVPL,.NL,.OUTPUT)
145 Q
146 ;
147 ;=================================================
148TERM(IEN,LBBDT,LBEDT,RBDT,REDT,PXRMFVPL,NL,OUTPUT) ;
149 N TERMARR
150 D TERM^PXRMLDR(IEN,.TERMARR)
151 D DATES^PXRMRUL1(LBBDT,LBEDT,RBDT,REDT,.TERMARR)
152 S NL=NL+1,OUTPUT(NL)=" TERM "_$P(TERMARR(0),U,1)
153 D FMULPRT(.TERMARR,.PXRMFVPL,.NL,.OUTPUT)
154 Q
155 ;
Note: See TracBrowser for help on using the repository browser.