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

PXRMLDR ; SLC/PKR - Load Definitions and terms for evaluation. ;08/09/2004
 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
 ;
 ;===================================
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")
 ;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 an expanded taxonomy into TAXARR.
 I '$D(^PXD(811.2,TAXIEN)) Q
 ;Make sure the taxonomy has been expanded.
 D CHECK^PXRMBXTL(TAXIEN,"")
 I '$$LOCKXTL^PXRMBXTL(TAXIEN) D  Q
 . S TAXARR(0)="NO LOCK FOR TAXONOMY "_TAXIEN
 N CFN,NODE,NNODE,SFN
 S TAXARR(0)=^PXD(811.3,TAXIEN,0)
 M TAXARR(71)=^PXD(811.3,TAXIEN,71,"RCPTP")
 M TAXARR(80)=^PXD(811.3,TAXIEN,80,"ICD9P")
 M TAXARR(80.1)=^PXD(811.3,TAXIEN,80.1,"ICD0P")
 M TAXARR(81)=^PXD(811.3,TAXIEN,81,"ICPTP")
 S SFN=0
 F  S SFN=+$O(^PXD(811.3,TAXIEN,"PDS",SFN)) Q:SFN=0  D
 . S CFN=0
 . F  S CFN=+$O(^PXD(811.3,TAXIEN,"PDS",SFN,1,CFN)) Q:CFN=0  D
 .. S TAXARR("PDS",SFN,CFN)=^PXD(811.3,TAXIEN,"PDS",SFN,1,CFN,0)
 .. S NNODE=$P(TAXARR("PDS",SFN,CFN),U,2)
 .. F NODE=1:1:NNODE S TAXARR("PDS",SFN,CFN,NODE)=^PXD(811.3,TAXIEN,"PDS",SFN,1,CFN,1,NODE,0)
 D ULOCKXTL^PXRMBXTL(TAXIEN)
 S TAXARR("IEN")=TAXIEN
 S TAXARR(811.2,0)=^PXD(811.2,TAXIEN,0)
 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
 ;