PXRMLDR ;SLC/PKR - Load Definitions and terms for evaluation. ;04/01/2022
;;2.0;CLINICAL REMINDERS;**18,26,47,42,65**;Feb 04, 2005;Build 438
;
;===================================
DEF(DEFID,DEFARR) ;Load those portions of the definition needed for
;evaluation.
N DEFIEN
K DEFARR
I DEFID="" S DEFARR("DNE")=1,DEFARR("IEN")="NULL" Q
S DEFIEN=$S(+DEFID>0:DEFID,1:$O(^PXD(811.9,"B",DEFID,"")))
I DEFIEN="" S DEFARR("DNE")=1,DEFARR("IEN")="NULL" Q
S DEFARR("IEN")=DEFIEN
I '$D(^PXD(811.9,DEFIEN)) S DEFARR("DNE")=1 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))
S DEFARR(80)=$G(^PXD(811.9,DEFIEN,80))
S DEFARR(81)=$G(^PXD(811.9,DEFIEN,81))
S DEFARR(90)=$G(^PXD(811.9,DEFIEN,90))
S DEFARR(91)=$G(^PXD(811.9,DEFIEN,91))
;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 line count 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))
S DEFARR(85)=$G(^PXD(811.9,DEFIEN,85))
S DEFARR(95)=$G(^PXD(811.9,DEFIEN,95))
;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(TAXID,TAXARR) ;Load a taxonomy into TAXARR for evaluation.
N TAXIEN
K TAXARR
I TAXID="" S TAXARR("DNE")=1,TAXARR("IEN")="NULL" Q
S TAXIEN=$S(+TAXID>0:TAXID,1:$O(^PXD(811.2,"B",TAXID,"")))
I TAXIEN="" S TAXARR("DNE")=1,TAXARR("IEN")="NULL" Q
S TAXARR("IEN")=TAXIEN
I '$D(^PXD(811.2,TAXIEN)) S TAXARR("DNE")=1 Q
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(TERMID,TERMARR) ;Load those portions of the term needed for
;evaluation.
N TERMIEN
K TERMARR
I TERMID="" S TERMARR("DNE")=1,TERMARR("IEN")="NULL" Q
S TERMIEN=$S(+TERMID>0:TERMID,1:$O(^PXRMD(811.5,"B",TERMID,"")))
I TERMIEN="" S TERMARR("DNE")=1,TERMARR("IEN")="NULL" Q
S TERMARR("IEN")=TERMIEN
I '$D(^PXRMD(811.5,TERMIEN)) S TERMARR("DNE")=1 Q
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMLDR 5044 printed Dec 13, 2024@01:46:23 Page 2
PXRMLDR ;SLC/PKR - Load Definitions and terms for evaluation. ;04/01/2022
+1 ;;2.0;CLINICAL REMINDERS;**18,26,47,42,65**;Feb 04, 2005;Build 438
+2 ;
+3 ;===================================
DEF(DEFID,DEFARR) ;Load those portions of the definition needed for
+1 ;evaluation.
+2 NEW DEFIEN
+3 KILL DEFARR
+4 IF DEFID=""
SET DEFARR("DNE")=1
SET DEFARR("IEN")="NULL"
QUIT
+5 SET DEFIEN=$SELECT(+DEFID>0:DEFID,1:$ORDER(^PXD(811.9,"B",DEFID,"")))
+6 IF DEFIEN=""
SET DEFARR("DNE")=1
SET DEFARR("IEN")="NULL"
QUIT
+7 SET DEFARR("IEN")=DEFIEN
+8 IF '$DATA(^PXD(811.9,DEFIEN))
SET DEFARR("DNE")=1
QUIT
+9 NEW FTYPE,IND,JND,STL
+10 SET STL=0
+11 SET DEFARR(0)=^PXD(811.9,DEFIEN,0)
+12 ;Baseline
+13 SET IND=0
+14 FOR
SET IND=+$ORDER(^PXD(811.9,DEFIEN,7,IND))
if IND=0
QUIT
Begin DoDot:1
+15 SET DEFARR(7,IND,0)=^PXD(811.9,DEFIEN,7,IND,0)
+16 SET DEFARR(7,IND,3)=^PXD(811.9,DEFIEN,7,IND,3)
End DoDot:1
+17 ;Load the findings multiple.
+18 SET IND=0
+19 FOR
SET IND=+$ORDER(^PXD(811.9,DEFIEN,20,IND))
if IND=0
QUIT
Begin DoDot:1
+20 SET DEFARR(20,IND,0)=^PXD(811.9,DEFIEN,20,IND,0)
+21 SET DEFARR(20,IND,3)=$GET(^PXD(811.9,DEFIEN,20,IND,3))
+22 SET DEFARR(20,IND,6)=$GET(^PXD(811.9,DEFIEN,20,IND,6))
+23 SET DEFARR(20,IND,10)=$GET(^PXD(811.9,DEFIEN,20,IND,10))
+24 SET DEFARR(20,IND,11)=$GET(^PXD(811.9,DEFIEN,20,IND,11))
+25 SET DEFARR(20,IND,15)=$GET(^PXD(811.9,DEFIEN,20,IND,15))
+26 SET JND=0
+27 FOR
SET JND=+$ORDER(^PXD(811.9,DEFIEN,20,IND,5,JND))
if JND=0
QUIT
Begin DoDot:2
+28 SET DEFARR(20,IND,5,JND)=^PXD(811.9,DEFIEN,20,IND,5,JND,0)
End DoDot:2
End DoDot:1
+29 MERGE DEFARR("E")=^PXD(811.9,DEFIEN,20,"E")
+30 MERGE DEFARR("EDEP")=^PXD(811.9,DEFIEN,20,"EDEP")
+31 ;Load the function findings.
+32 SET IND=0
+33 FOR
SET IND=+$ORDER(^PXD(811.9,DEFIEN,25,IND))
if IND=0
QUIT
Begin DoDot:1
+34 MERGE DEFARR(25,"FF"_IND)=^PXD(811.9,DEFIEN,25,IND)
End DoDot:1
+35 ;Load the logic fields.
+36 SET DEFARR(31)=$GET(^PXD(811.9,DEFIEN,31))
+37 SET DEFARR(32)=$GET(^PXD(811.9,DEFIEN,32))
+38 SET DEFARR(35)=$GET(^PXD(811.9,DEFIEN,35))
+39 SET DEFARR(36)=$GET(^PXD(811.9,DEFIEN,36))
+40 SET DEFARR(40)=$GET(^PXD(811.9,DEFIEN,40))
+41 SET DEFARR(42)=$GET(^PXD(811.9,DEFIEN,42))
+42 SET DEFARR(80)=$GET(^PXD(811.9,DEFIEN,80))
+43 SET DEFARR(81)=$GET(^PXD(811.9,DEFIEN,81))
+44 SET DEFARR(90)=$GET(^PXD(811.9,DEFIEN,90))
+45 SET DEFARR(91)=$GET(^PXD(811.9,DEFIEN,91))
+46 ;Load the custom date due fields.
+47 SET DEFARR(45)=$GET(^PXD(811.9,DEFIEN,45))
+48 IF $LENGTH(DEFARR(45))>0
Begin DoDot:1
+49 MERGE DEFARR(46)=^PXD(811.9,DEFIEN,46)
+50 MERGE DEFARR(47)=^PXD(811.9,DEFIEN,47)
+51 KILL DEFARR(47,0),DEFARR(47,"B")
End DoDot:1
+52 ;Load the logic found/not found text line count fields.
+53 SET DEFARR(62)=$GET(^PXD(811.9,DEFIEN,62))
+54 SET DEFARR(67)=$GET(^PXD(811.9,DEFIEN,67))
+55 SET DEFARR(72)=$GET(^PXD(811.9,DEFIEN,72))
+56 SET DEFARR(77)=$GET(^PXD(811.9,DEFIEN,77))
+57 SET DEFARR(85)=$GET(^PXD(811.9,DEFIEN,85))
+58 SET DEFARR(95)=$GET(^PXD(811.9,DEFIEN,95))
+59 ;Check for finding list strings too long.
+60 IF DEFARR(32)=-1
SET STL=1
SET FTYPE="cohort"
+61 IF DEFARR(36)=-1
SET STL=1
SET FTYPE="resolution"
+62 IF DEFARR(40)=-1
SET STL=1
SET FTYPE="age"
+63 IF DEFARR(42)=-1
SET STL=1
SET FTYPE="information"
+64 IF STL
SET $PIECE(DEFARR(0),U,6,7)=1_U_$$NOW^XLFDT
DO ERRMSG^PXRMLOGX(FTYPE)
+65 QUIT
+66 ;
+67 ;===================================
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(TAXID,TAXARR) ;Load a taxonomy into TAXARR for evaluation.
+1 NEW TAXIEN
+2 KILL TAXARR
+3 IF TAXID=""
SET TAXARR("DNE")=1
SET TAXARR("IEN")="NULL"
QUIT
+4 SET TAXIEN=$SELECT(+TAXID>0:TAXID,1:$ORDER(^PXD(811.2,"B",TAXID,"")))
+5 IF TAXIEN=""
SET TAXARR("DNE")=1
SET TAXARR("IEN")="NULL"
QUIT
+6 SET TAXARR("IEN")=TAXIEN
+7 IF '$DATA(^PXD(811.2,TAXIEN))
SET TAXARR("DNE")=1
QUIT
+8 MERGE TAXARR("AE")=^PXD(811.2,TAXIEN,20,"AE")
+9 MERGE TAXARR("APDS")=^PXD(811.2,TAXIEN,"APDS")
+10 SET TAXARR(0)=^PXD(811.2,TAXIEN,0)
+11 SET TAXARR(15)=$GET(^PXD(811.2,TAXIEN,15))
+12 QUIT
+13 ;
+14 ;===================================
TERM(TERMID,TERMARR) ;Load those portions of the term needed for
+1 ;evaluation.
+2 NEW TERMIEN
+3 KILL TERMARR
+4 IF TERMID=""
SET TERMARR("DNE")=1
SET TERMARR("IEN")="NULL"
QUIT
+5 SET TERMIEN=$SELECT(+TERMID>0:TERMID,1:$ORDER(^PXRMD(811.5,"B",TERMID,"")))
+6 IF TERMIEN=""
SET TERMARR("DNE")=1
SET TERMARR("IEN")="NULL"
QUIT
+7 SET TERMARR("IEN")=TERMIEN
+8 IF '$DATA(^PXRMD(811.5,TERMIEN))
SET TERMARR("DNE")=1
QUIT
+9 NEW IND,JND
+10 SET TERMARR(0)=^PXRMD(811.5,TERMIEN,0)
+11 ;Load the findings multiple.
+12 SET IND=0
+13 FOR
SET IND=+$ORDER(^PXRMD(811.5,TERMIEN,20,IND))
if IND=0
QUIT
Begin DoDot:1
+14 SET TERMARR(20,IND,0)=^PXRMD(811.5,TERMIEN,20,IND,0)
+15 SET TERMARR(20,IND,3)=$GET(^PXRMD(811.5,TERMIEN,20,IND,3))
+16 SET TERMARR(20,IND,10)=$GET(^PXRMD(811.5,TERMIEN,20,IND,10))
+17 SET TERMARR(20,IND,11)=$GET(^PXRMD(811.5,TERMIEN,20,IND,11))
+18 SET TERMARR(20,IND,15)=$GET(^PXRMD(811.5,TERMIEN,20,IND,15))
+19 SET JND=0
+20 FOR
SET JND=+$ORDER(^PXRMD(811.5,TERMIEN,20,IND,5,JND))
if JND=0
QUIT
Begin DoDot:2
+21 SET TERMARR(20,IND,5,JND)=^PXRMD(811.5,TERMIEN,20,IND,5,JND,0)
End DoDot:2
End DoDot:1
+22 MERGE TERMARR("E")=^PXRMD(811.5,TERMIEN,20,"E")
+23 SET TERMARR("IEN")=TERMIEN
+24 QUIT
+25 ;
