source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLDR.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1PXRMLDR ; SLC/PKR - Load Definitions and terms for evaluation. ;08/09/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;===================================
5DEF(DEFIEN,DEFARR) ;Load those portions of the definition needed for
6 ;evaluation.
7 K DEFARR
8 S DEFARR("IEN")=DEFIEN
9 I '$D(^PXD(811.9,DEFIEN)) S DEFARR("DNE")="" Q
10 N FTYPE,IND,JND,STL
11 S STL=0
12 S DEFARR(0)=^PXD(811.9,DEFIEN,0)
13 ;Baseline
14 S IND=0
15 F S IND=+$O(^PXD(811.9,DEFIEN,7,IND)) Q:IND=0 D
16 . S DEFARR(7,IND,0)=^PXD(811.9,DEFIEN,7,IND,0)
17 . S DEFARR(7,IND,3)=^PXD(811.9,DEFIEN,7,IND,3)
18 ;Load the findings multiple.
19 S IND=0
20 F S IND=+$O(^PXD(811.9,DEFIEN,20,IND)) Q:IND=0 D
21 . S DEFARR(20,IND,0)=^PXD(811.9,DEFIEN,20,IND,0)
22 . S DEFARR(20,IND,3)=$G(^PXD(811.9,DEFIEN,20,IND,3))
23 . S DEFARR(20,IND,6)=$G(^PXD(811.9,DEFIEN,20,IND,6))
24 . S DEFARR(20,IND,10)=$G(^PXD(811.9,DEFIEN,20,IND,10))
25 . S DEFARR(20,IND,11)=$G(^PXD(811.9,DEFIEN,20,IND,11))
26 . S DEFARR(20,IND,15)=$G(^PXD(811.9,DEFIEN,20,IND,15))
27 . S JND=0
28 . F S JND=+$O(^PXD(811.9,DEFIEN,20,IND,5,JND)) Q:JND=0 D
29 .. S DEFARR(20,IND,5,JND)=^PXD(811.9,DEFIEN,20,IND,5,JND,0)
30 M DEFARR("E")=^PXD(811.9,DEFIEN,20,"E")
31 ;Load the function findings.
32 S IND=0
33 F S IND=+$O(^PXD(811.9,DEFIEN,25,IND)) Q:IND=0 D
34 . M DEFARR(25,"FF"_IND)=^PXD(811.9,DEFIEN,25,IND)
35 ;Load the logic fields.
36 S DEFARR(31)=$G(^PXD(811.9,DEFIEN,31))
37 S DEFARR(32)=$G(^PXD(811.9,DEFIEN,32))
38 S DEFARR(35)=$G(^PXD(811.9,DEFIEN,35))
39 S DEFARR(36)=$G(^PXD(811.9,DEFIEN,36))
40 S DEFARR(40)=$G(^PXD(811.9,DEFIEN,40))
41 S DEFARR(42)=$G(^PXD(811.9,DEFIEN,42))
42 ;Load the custom date due fields.
43 S DEFARR(45)=$G(^PXD(811.9,DEFIEN,45))
44 I $L(DEFARR(45))>0 D
45 . M DEFARR(46)=^PXD(811.9,DEFIEN,46)
46 . M DEFARR(47)=^PXD(811.9,DEFIEN,47)
47 . K DEFARR(47,0),DEFARR(47,"B")
48 ;Load the logic found/not found text fields.
49 S DEFARR(62)=$G(^PXD(811.9,DEFIEN,62))
50 S DEFARR(67)=$G(^PXD(811.9,DEFIEN,67))
51 S DEFARR(72)=$G(^PXD(811.9,DEFIEN,72))
52 S DEFARR(77)=$G(^PXD(811.9,DEFIEN,77))
53 ;Check for finding list strings too long.
54 I DEFARR(32)=-1 S STL=1,FTYPE="cohort"
55 I DEFARR(36)=-1 S STL=1,FTYPE="resolution"
56 I DEFARR(40)=-1 S STL=1,FTYPE="age"
57 I DEFARR(42)=-1 S STL=1,FTYPE="information"
58 I STL S $P(DEFARR(0),U,6,7)=1_U_$$NOW^XLFDT D ERRMSG^PXRMLOGX(FTYPE)
59 Q
60 ;
61 ;===================================
62EDITFM0(FINDING,FIELD,VALUE,FARR) ;For finding number FINDING set the
63 ;field named field to the value VALUE in FARR.
64 N NTP,PIECE
65 S NTP("MINIMUM AGE")=2,NTP("MAXIMUM AGE")=3,NTP("REMINDER FREQUENCY")=4
66 S NTP("RANK FREQUENCY")=5,NTP("USE IN RESOLUTION LOGIC")=6
67 S NTP("USE IN PATIENT COHORT LOGIC")=7,NTP("BEGINNING DATE/TIME")=8
68 S NTP("USE INACTIVE PROBLEMS")=9,NTP("WITHIN CATEGORY RANK")=10
69 S NTP("ENDING DATE/TIME")=11,NTP("MH SCALE")=12
70 S NTP("RX TYPE")=13,NTP("OCCURRENCE COUNT")=14
71 S PIECE=NTP(FIELD)
72 S $P(FARR(20,FINDING,0),U,PIECE)=VALUE
73 Q
74 ;
75 ;===================================
76TAX(TAXIEN,TAXARR) ;Load an expanded taxonomy into TAXARR.
77 I '$D(^PXD(811.2,TAXIEN)) Q
78 ;Make sure the taxonomy has been expanded.
79 D CHECK^PXRMBXTL(TAXIEN,"")
80 I '$$LOCKXTL^PXRMBXTL(TAXIEN) D Q
81 . S TAXARR(0)="NO LOCK FOR TAXONOMY "_TAXIEN
82 N CFN,NODE,NNODE,SFN
83 S TAXARR(0)=^PXD(811.3,TAXIEN,0)
84 M TAXARR(71)=^PXD(811.3,TAXIEN,71,"RCPTP")
85 M TAXARR(80)=^PXD(811.3,TAXIEN,80,"ICD9P")
86 M TAXARR(80.1)=^PXD(811.3,TAXIEN,80.1,"ICD0P")
87 M TAXARR(81)=^PXD(811.3,TAXIEN,81,"ICPTP")
88 S SFN=0
89 F S SFN=+$O(^PXD(811.3,TAXIEN,"PDS",SFN)) Q:SFN=0 D
90 . S CFN=0
91 . F S CFN=+$O(^PXD(811.3,TAXIEN,"PDS",SFN,1,CFN)) Q:CFN=0 D
92 .. S TAXARR("PDS",SFN,CFN)=^PXD(811.3,TAXIEN,"PDS",SFN,1,CFN,0)
93 .. S NNODE=$P(TAXARR("PDS",SFN,CFN),U,2)
94 .. F NODE=1:1:NNODE S TAXARR("PDS",SFN,CFN,NODE)=^PXD(811.3,TAXIEN,"PDS",SFN,1,CFN,1,NODE,0)
95 D ULOCKXTL^PXRMBXTL(TAXIEN)
96 S TAXARR("IEN")=TAXIEN
97 S TAXARR(811.2,0)=^PXD(811.2,TAXIEN,0)
98 Q
99 ;
100 ;===================================
101TERM(TERMIEN,TERMARR) ;Load those portions of the term needed for
102 ;evaluation.
103 I '$D(^PXRMD(811.5,TERMIEN)) Q
104 K TERMARR
105 N IND,JND
106 S TERMARR(0)=^PXRMD(811.5,TERMIEN,0)
107 ;Load the findings multiple.
108 S IND=0
109 F S IND=+$O(^PXRMD(811.5,TERMIEN,20,IND)) Q:IND=0 D
110 . S TERMARR(20,IND,0)=^PXRMD(811.5,TERMIEN,20,IND,0)
111 . S TERMARR(20,IND,3)=$G(^PXRMD(811.5,TERMIEN,20,IND,3))
112 . S TERMARR(20,IND,10)=$G(^PXRMD(811.5,TERMIEN,20,IND,10))
113 . S TERMARR(20,IND,11)=$G(^PXRMD(811.5,TERMIEN,20,IND,11))
114 . S TERMARR(20,IND,15)=$G(^PXRMD(811.5,TERMIEN,20,IND,15))
115 . S JND=0
116 . F S JND=+$O(^PXRMD(811.5,TERMIEN,20,IND,5,JND)) Q:JND=0 D
117 .. S TERMARR(20,IND,5,JND)=^PXRMD(811.5,TERMIEN,20,IND,5,JND,0)
118 M TERMARR("E")=^PXRMD(811.5,TERMIEN,20,"E")
119 S TERMARR("IEN")=TERMIEN
120 Q
121 ;
Note: See TracBrowser for help on using the repository browser.