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 ;