PXRMLDR ;SLC/PKR - Load Definitions and terms for evaluation. ;09/04/2012
;;2.0;CLINICAL REMINDERS;**18,26**;Feb 04, 2005;Build 404
;
;===================================
DEF(DEFIEN,DEFARR) ;Load those portions of the definition needed for
;evaluation.
K DEFARR
S DEFARR("IEN")=DEFIEN
I '$D(^PXD(811.9,DEFIEN)) S DEFARR("DNE")="" Q
N FTYPE,IND,JND,STL
S STL=0
S DEFARR(0)=^PXD(811.9,DEFIEN,0)
;Baseline
S IND=0
F S IND=+$O(^PXD(811.9,DEFIEN,7,IND)) Q:IND=0 D
. S DEFARR(7,IND,0)=^PXD(811.9,DEFIEN,7,IND,0)
. S DEFARR(7,IND,3)=^PXD(811.9,DEFIEN,7,IND,3)
;Load the findings multiple.
S IND=0
F S IND=+$O(^PXD(811.9,DEFIEN,20,IND)) Q:IND=0 D
. S DEFARR(20,IND,0)=^PXD(811.9,DEFIEN,20,IND,0)
. S DEFARR(20,IND,3)=$G(^PXD(811.9,DEFIEN,20,IND,3))
. S DEFARR(20,IND,6)=$G(^PXD(811.9,DEFIEN,20,IND,6))
. S DEFARR(20,IND,10)=$G(^PXD(811.9,DEFIEN,20,IND,10))
. S DEFARR(20,IND,11)=$G(^PXD(811.9,DEFIEN,20,IND,11))
. S DEFARR(20,IND,15)=$G(^PXD(811.9,DEFIEN,20,IND,15))
. S JND=0
. F S JND=+$O(^PXD(811.9,DEFIEN,20,IND,5,JND)) Q:JND=0 D
.. S DEFARR(20,IND,5,JND)=^PXD(811.9,DEFIEN,20,IND,5,JND,0)
M DEFARR("E")=^PXD(811.9,DEFIEN,20,"E")
M DEFARR("EDEP")=^PXD(811.9,DEFIEN,20,"EDEP")
;Load the function findings.
S IND=0
F S IND=+$O(^PXD(811.9,DEFIEN,25,IND)) Q:IND=0 D
. M DEFARR(25,"FF"_IND)=^PXD(811.9,DEFIEN,25,IND)
;Load the logic fields.
S DEFARR(31)=$G(^PXD(811.9,DEFIEN,31))
S DEFARR(32)=$G(^PXD(811.9,DEFIEN,32))
S DEFARR(35)=$G(^PXD(811.9,DEFIEN,35))
S DEFARR(36)=$G(^PXD(811.9,DEFIEN,36))
S DEFARR(40)=$G(^PXD(811.9,DEFIEN,40))
S DEFARR(42)=$G(^PXD(811.9,DEFIEN,42))
;Load the custom date due fields.
S DEFARR(45)=$G(^PXD(811.9,DEFIEN,45))
I $L(DEFARR(45))>0 D
. M DEFARR(46)=^PXD(811.9,DEFIEN,46)
. M DEFARR(47)=^PXD(811.9,DEFIEN,47)
. K DEFARR(47,0),DEFARR(47,"B")
;Load the logic found/not found text fields.
S DEFARR(62)=$G(^PXD(811.9,DEFIEN,62))
S DEFARR(67)=$G(^PXD(811.9,DEFIEN,67))
S DEFARR(72)=$G(^PXD(811.9,DEFIEN,72))
S DEFARR(77)=$G(^PXD(811.9,DEFIEN,77))
;Check for finding list strings too long.
I DEFARR(32)=-1 S STL=1,FTYPE="cohort"
I DEFARR(36)=-1 S STL=1,FTYPE="resolution"
I DEFARR(40)=-1 S STL=1,FTYPE="age"
I DEFARR(42)=-1 S STL=1,FTYPE="information"
I STL S $P(DEFARR(0),U,6,7)=1_U_$$NOW^XLFDT D ERRMSG^PXRMLOGX(FTYPE)
Q
;
;===================================
EDITFM0(FINDING,FIELD,VALUE,FARR) ;For finding number FINDING set the
;field named field to the value VALUE in FARR.
N NTP,PIECE
S NTP("MINIMUM AGE")=2,NTP("MAXIMUM AGE")=3,NTP("REMINDER FREQUENCY")=4
S NTP("RANK FREQUENCY")=5,NTP("USE IN RESOLUTION LOGIC")=6
S NTP("USE IN PATIENT COHORT LOGIC")=7,NTP("BEGINNING DATE/TIME")=8
S NTP("USE INACTIVE PROBLEMS")=9,NTP("WITHIN CATEGORY RANK")=10
S NTP("ENDING DATE/TIME")=11,NTP("MH SCALE")=12
S NTP("RX TYPE")=13,NTP("OCCURRENCE COUNT")=14
S PIECE=NTP(FIELD)
S $P(FARR(20,FINDING,0),U,PIECE)=VALUE
Q
;
;===================================
TAX(TAXIEN,TAXARR) ;Load a taxonomy into TAXARR for evaluation.
S TAXARR("IEN")=TAXIEN
M TAXARR("AE")=^PXD(811.2,TAXIEN,20,"AE")
M TAXARR("APDS")=^PXD(811.2,TAXIEN,"APDS")
S TAXARR(0)=^PXD(811.2,TAXIEN,0)
S TAXARR(15)=$G(^PXD(811.2,TAXIEN,15))
Q
;
;===================================
TERM(TERMIEN,TERMARR) ;Load those portions of the term needed for
;evaluation.
I '$D(^PXRMD(811.5,TERMIEN)) Q
K TERMARR
N IND,JND
S TERMARR(0)=^PXRMD(811.5,TERMIEN,0)
;Load the findings multiple.
S IND=0
F S IND=+$O(^PXRMD(811.5,TERMIEN,20,IND)) Q:IND=0 D
. S TERMARR(20,IND,0)=^PXRMD(811.5,TERMIEN,20,IND,0)
. S TERMARR(20,IND,3)=$G(^PXRMD(811.5,TERMIEN,20,IND,3))
. S TERMARR(20,IND,10)=$G(^PXRMD(811.5,TERMIEN,20,IND,10))
. S TERMARR(20,IND,11)=$G(^PXRMD(811.5,TERMIEN,20,IND,11))
. S TERMARR(20,IND,15)=$G(^PXRMD(811.5,TERMIEN,20,IND,15))
. S JND=0
. F S JND=+$O(^PXRMD(811.5,TERMIEN,20,IND,5,JND)) Q:JND=0 D
.. S TERMARR(20,IND,5,JND)=^PXRMD(811.5,TERMIEN,20,IND,5,JND,0)
M TERMARR("E")=^PXRMD(811.5,TERMIEN,20,"E")
S TERMARR("IEN")=TERMIEN
Q
;
PXRMLDR ;SLC/PKR - Load Definitions and terms for evaluation. ;09/04/2012
+1 ;;2.0;CLINICAL REMINDERS;**18,26**;Feb 04, 2005;Build 404
+2 ;
+3 ;===================================
DEF(DEFIEN,DEFARR) ;Load those portions of the definition needed for
+1 ;evaluation.
+2 KILL DEFARR
+3 SET DEFARR("IEN")=DEFIEN
+4 IF '$DATA(^PXD(811.9,DEFIEN))
SET DEFARR("DNE")=""
QUIT
+5 NEW FTYPE,IND,JND,STL
+6 SET STL=0
+7 SET DEFARR(0)=^PXD(811.9,DEFIEN,0)
+8 ;Baseline
+9 SET IND=0
+10 FOR
SET IND=+$ORDER(^PXD(811.9,DEFIEN,7,IND))
IF IND=0
QUIT
Begin DoDot:1
+11 SET DEFARR(7,IND,0)=^PXD(811.9,DEFIEN,7,IND,0)
+12 SET DEFARR(7,IND,3)=^PXD(811.9,DEFIEN,7,IND,3)
End DoDot:1
+13 ;Load the findings multiple.
+14 SET IND=0
+15 FOR
SET IND=+$ORDER(^PXD(811.9,DEFIEN,20,IND))
IF IND=0
QUIT
Begin DoDot:1
+16 SET DEFARR(20,IND,0)=^PXD(811.9,DEFIEN,20,IND,0)
+17 SET DEFARR(20,IND,3)=$GET(^PXD(811.9,DEFIEN,20,IND,3))
+18 SET DEFARR(20,IND,6)=$GET(^PXD(811.9,DEFIEN,20,IND,6))
+19 SET DEFARR(20,IND,10)=$GET(^PXD(811.9,DEFIEN,20,IND,10))
+20 SET DEFARR(20,IND,11)=$GET(^PXD(811.9,DEFIEN,20,IND,11))
+21 SET DEFARR(20,IND,15)=$GET(^PXD(811.9,DEFIEN,20,IND,15))
+22 SET JND=0
+23 FOR
SET JND=+$ORDER(^PXD(811.9,DEFIEN,20,IND,5,JND))
IF JND=0
QUIT
Begin DoDot:2
+24 SET DEFARR(20,IND,5,JND)=^PXD(811.9,DEFIEN,20,IND,5,JND,0)
End DoDot:2
End DoDot:1
+25 MERGE DEFARR("E")=^PXD(811.9,DEFIEN,20,"E")
+26 MERGE DEFARR("EDEP")=^PXD(811.9,DEFIEN,20,"EDEP")
+27 ;Load the function findings.
+28 SET IND=0
+29 FOR
SET IND=+$ORDER(^PXD(811.9,DEFIEN,25,IND))
IF IND=0
QUIT
Begin DoDot:1
+30 MERGE DEFARR(25,"FF"_IND)=^PXD(811.9,DEFIEN,25,IND)
End DoDot:1
+31 ;Load the logic fields.
+32 SET DEFARR(31)=$GET(^PXD(811.9,DEFIEN,31))
+33 SET DEFARR(32)=$GET(^PXD(811.9,DEFIEN,32))
+34 SET DEFARR(35)=$GET(^PXD(811.9,DEFIEN,35))
+35 SET DEFARR(36)=$GET(^PXD(811.9,DEFIEN,36))
+36 SET DEFARR(40)=$GET(^PXD(811.9,DEFIEN,40))
+37 SET DEFARR(42)=$GET(^PXD(811.9,DEFIEN,42))
+38 ;Load the custom date due fields.
+39 SET DEFARR(45)=$GET(^PXD(811.9,DEFIEN,45))
+40 IF $LENGTH(DEFARR(45))>0
Begin DoDot:1
+41 MERGE DEFARR(46)=^PXD(811.9,DEFIEN,46)
+42 MERGE DEFARR(47)=^PXD(811.9,DEFIEN,47)
+43 KILL DEFARR(47,0),DEFARR(47,"B")
End DoDot:1
+44 ;Load the logic found/not found text fields.
+45 SET DEFARR(62)=$GET(^PXD(811.9,DEFIEN,62))
+46 SET DEFARR(67)=$GET(^PXD(811.9,DEFIEN,67))
+47 SET DEFARR(72)=$GET(^PXD(811.9,DEFIEN,72))
+48 SET DEFARR(77)=$GET(^PXD(811.9,DEFIEN,77))
+49 ;Check for finding list strings too long.
+50 IF DEFARR(32)=-1
SET STL=1
SET FTYPE="cohort"
+51 IF DEFARR(36)=-1
SET STL=1
SET FTYPE="resolution"
+52 IF DEFARR(40)=-1
SET STL=1
SET FTYPE="age"
+53 IF DEFARR(42)=-1
SET STL=1
SET FTYPE="information"
+54 IF STL
SET $PIECE(DEFARR(0),U,6,7)=1_U_$$NOW^XLFDT
DO ERRMSG^PXRMLOGX(FTYPE)
+55 QUIT
+56 ;
+57 ;===================================
EDITFM0(FINDING,FIELD,VALUE,FARR) ;For finding number FINDING set the
+1 ;field named field to the value VALUE in FARR.
+2 NEW NTP,PIECE
+3 SET NTP("MINIMUM AGE")=2
SET NTP("MAXIMUM AGE")=3
SET NTP("REMINDER FREQUENCY")=4
+4 SET NTP("RANK FREQUENCY")=5
SET NTP("USE IN RESOLUTION LOGIC")=6
+5 SET NTP("USE IN PATIENT COHORT LOGIC")=7
SET NTP("BEGINNING DATE/TIME")=8
+6 SET NTP("USE INACTIVE PROBLEMS")=9
SET NTP("WITHIN CATEGORY RANK")=10
+7 SET NTP("ENDING DATE/TIME")=11
SET NTP("MH SCALE")=12
+8 SET NTP("RX TYPE")=13
SET NTP("OCCURRENCE COUNT")=14
+9 SET PIECE=NTP(FIELD)
+10 SET $PIECE(FARR(20,FINDING,0),U,PIECE)=VALUE
+11 QUIT
+12 ;
+13 ;===================================
TAX(TAXIEN,TAXARR) ;Load a taxonomy into TAXARR for evaluation.
+1 SET TAXARR("IEN")=TAXIEN
+2 MERGE TAXARR("AE")=^PXD(811.2,TAXIEN,20,"AE")
+3 MERGE TAXARR("APDS")=^PXD(811.2,TAXIEN,"APDS")
+4 SET TAXARR(0)=^PXD(811.2,TAXIEN,0)
+5 SET TAXARR(15)=$GET(^PXD(811.2,TAXIEN,15))
+6 QUIT
+7 ;
+8 ;===================================
TERM(TERMIEN,TERMARR) ;Load those portions of the term needed for
+1 ;evaluation.
+2 IF '$DATA(^PXRMD(811.5,TERMIEN))
QUIT
+3 KILL TERMARR
+4 NEW IND,JND
+5 SET TERMARR(0)=^PXRMD(811.5,TERMIEN,0)
+6 ;Load the findings multiple.
+7 SET IND=0
+8 FOR
SET IND=+$ORDER(^PXRMD(811.5,TERMIEN,20,IND))
IF IND=0
QUIT
Begin DoDot:1
+9 SET TERMARR(20,IND,0)=^PXRMD(811.5,TERMIEN,20,IND,0)
+10 SET TERMARR(20,IND,3)=$GET(^PXRMD(811.5,TERMIEN,20,IND,3))
+11 SET TERMARR(20,IND,10)=$GET(^PXRMD(811.5,TERMIEN,20,IND,10))
+12 SET TERMARR(20,IND,11)=$GET(^PXRMD(811.5,TERMIEN,20,IND,11))
+13 SET TERMARR(20,IND,15)=$GET(^PXRMD(811.5,TERMIEN,20,IND,15))
+14 SET JND=0
+15 FOR
SET JND=+$ORDER(^PXRMD(811.5,TERMIEN,20,IND,5,JND))
IF JND=0
QUIT
Begin DoDot:2
+16 SET TERMARR(20,IND,5,JND)=^PXRMD(811.5,TERMIEN,20,IND,5,JND,0)
End DoDot:2
End DoDot:1
+17 MERGE TERMARR("E")=^PXRMD(811.5,TERMIEN,20,"E")
+18 SET TERMARR("IEN")=TERMIEN
+19 QUIT
+20 ;
