Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMLDR

PXRMLDR.m

Go to the documentation of this file.
PXRMLDR ;SLC/PKR - Load Definitions and terms for evaluation. ;04/19/2017
 ;;2.0;CLINICAL REMINDERS;**18,26,47**;Feb 04, 2005;Build 291
 ;
 ;===================================
DEF(DEFID,DEFARR) ;Load those portions of the definition needed for
 ;evaluation.
 N DEFIEN
 K DEFARR
 S DEFIEN=$S(+DEFID>0:DEFID,1:$O(^PXD(811.9,"B",DEFID,"")))
 I DEFIEN="" S DEFARR("DNE")="" Q
 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(TAXID,TAXARR) ;Load a taxonomy into TAXARR for evaluation.
 N TAXIEN
 K TAXARR
 S TAXIEN=$S(+TAXID>0:TAXID,1:$O(^PXD(811.2,"B",TAXID,"")))
 I TAXIEN="" S TAXARR("DNE")="" Q
 I '$D(^PXD(811.2,TAXIEN)) S TAXARR("DNE")="" Q
 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(TERMID,TERMARR) ;Load those portions of the term needed for
 ;evaluation.
 N TERMIEN
 K TERMARR
 S TERMIEN=$S(+TERMID>0:TERMID,1:$O(^PXRMD(811.5,"B",TERMID,"")))
 I TERMIEN="" S TERMARR("DNE")="" Q
 I '$D(^PXRMD(811.5,TERMIEN)) S TERMARR("DNE")="" 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
 ;