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

PXRMXX1.m

Go to the documentation of this file.
  1. PXRMXX1 ; SLC/PJH - Build list of reminder findings;08/03/2005
  1. ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
  1. ;
  1. ;Called at REM, REPORT and PSMERG from PXRMXX
  1. ;
  1. ;Merge the patients found by the pharmacy API
  1. ;--------------------------------------------
  1. PSMERG(TYP,NODE,SEARCH) ;
  1. N DATA,DATE,DCNT,DFN,DRUG,DSUP,FCNT,FINDING,FIEN,FLD,FTYP,FREC,FUNIQ
  1. N LAST,LDATE,NEXT,RDATE,SDATE,STOPDATE,TERM,TIEN,VTYP
  1. ;
  1. S DFN="",VTYP=$S(TYP="PXRMPSI":"I",1:"O")
  1. F S DFN=$O(^TMP(TYP_NODE,$J,DFN)) Q:'DFN D
  1. .;Get last entry for this patient created by reminder evaluation
  1. .S LAST=$O(^TMP(NODE,$J,DFN,"FIND",""),-1),NEXT=LAST+1,DCNT=0
  1. .;If this is a new patient update patient and finding count
  1. .I NEXT=1 S PXRMFCNT=PXRMFCNT+1,PXRMCNT=PXRMCNT+1
  1. .;Scan through medications found for this patient
  1. .F S DCNT=$O(^TMP(TYP_NODE,$J,DFN,DCNT)) Q:'DCNT D
  1. ..;Move data fields into FIEVAL format
  1. ..S FINDING=$P($G(^TMP(TYP_NODE,$J,DFN,DCNT,0)),U) Q:FINDING=""
  1. ..S DATA=$G(^TMP(TYP_NODE,$J,DFN,DCNT,1)),DATE=$P(DATA,U)
  1. ..S RDATE=$P(DATA,U,2),DRUG=$P(DATA,U,3),DSUP=$P(DATA,U,4)
  1. ..;Stop date
  1. ..S STOPDATE=$P(DATA,U,5)
  1. ..I +STOPDATE S DSUP=$$FMDIFF^XLFDT(STOPDATE,DATE,"")
  1. ..;Determine finding item/type
  1. ..S FTYPE=$P(FINDING,";",2),FIEN=$P(FINDING,";") Q:FIEN="" Q:FTYPE=""
  1. ..;Create file entry for each term
  1. ..S TIEN=""
  1. ..F S TIEN=$O(SEARCH(FTYPE,FIEN,TIEN)) Q:TIEN="" D
  1. ...F FLD="FINDING","DATE","RDATE","DRUG","DSUP","STOPDATE" D
  1. ....S ^TMP(NODE,$J,DFN,"FIND",NEXT,FLD)=@FLD
  1. ...;Get term name (no transforms)
  1. ...S ^TMP(NODE,$J,DFN,"FIND",NEXT,"TERM")=$P($G(^PXRMD(811.5,TIEN,0)),U)
  1. ...;Update header
  1. ...S ^TMP(NODE,$J,DFN,"FIND",NEXT)=DATE_U_VTYP
  1. ...;Update finding header
  1. ...S LDATE=$P($G(^TMP(NODE,$J,DFN)),U)
  1. ...I DATE>LDATE S ^TMP(NODE,$J,DFN)=DATE_U_VTYP
  1. ...;Save count by finding for report
  1. ...S FREC=$G(PXRMFIEN(FINDING)),FCNT=$P(FREC,U),FUNIQ=$P(FREC,U,2)
  1. ...S FCNT=FCNT+1 I '$G(FUNIQ(FIEN)) S FUNIQ=FUNIQ+1
  1. ...S PXRMFIEN(FINDING)=FCNT_U_FUNIQ,FUNIQ(FINDING)=1
  1. ...;Update count
  1. ...S NEXT=NEXT+1
  1. Q
  1. ;
  1. ;Build list of related findings
  1. ;------------------------------
  1. REM(PXRMITEM,OUTPUT,LAB) ;
  1. N COHORT,FTYPE,FIEN,FNODE,TNAM,TIEN
  1. S FTYPE=""
  1. ;Check if terms findings exist on the reminder
  1. F S FTYPE=$O(^PXD(811.9,PXRMITEM,20,"E",FTYPE)) Q:FTYPE="" D
  1. .;Check terms ONLY
  1. .I FTYPE="PXRMD(811.5," D Q
  1. ..N FTYPE S TIEN=""
  1. ..;Scan through terms in this reminder
  1. ..F S TIEN=$O(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,",TIEN)) Q:'TIEN D
  1. ...;Get the cohort flag
  1. ...S FNODE=$O(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,",TIEN,""))
  1. ...S COHORT="",FTYPE=""
  1. ...I FNODE S COHORT=$P($G(^PXD(811.9,PXRMITEM,20,FNODE,0)),U,7)
  1. ...;Scan through term looking for findings
  1. ...F S FTYPE=$O(^PXRMD(811.5,TIEN,20,"E",FTYPE)) Q:FTYPE="" D
  1. ....;Taxonomy findings
  1. ....I FTYPE="PXD(811.2," D RTAX Q
  1. ....;If Lab test and not in cohort ignore
  1. ....I FTYPE="LAB(60,",COHORT="" D Q
  1. .....;Only applies to lab extract reminder
  1. .....I $G(REM(PXRMITEM))'="VA-NATIONAL EPI LAB EXTRACT" Q
  1. .....;Get the term name for this lab test
  1. .....S TNAM=$P($G(^PXRMD(811.5,TIEN,0)),U) Q:TNAM=""
  1. .....S LAB(TNAM)=TIEN Q
  1. ....;Other findings
  1. ....D RSET
  1. Q
  1. ;
  1. ;Save report details
  1. ;-------------------
  1. REPORT(NODE) ;
  1. N RDATE,CNT,CN1,COUNT,DATA,LAST,OLD,DESC
  1. ;format rundate as MMDDYY
  1. S RDATE=$$DT^XLFDT,RDATE=$E(RDATE,4,5)_$E(RDATE,6,7)_$E(RDATE,2,3)
  1. ;Task Name
  1. S DESC="LREPI "_$E(PXRMEDT,2,3)_"/"_$E(PXRMEDT,4,5)_" "_RDATE
  1. S DATA=$G(^PXRMXT(810.3,0))
  1. ;Find next entry in report file
  1. S LAST=$P(DATA,U,3),COUNT=$P(DATA,U,4)+1,CNT=LAST+1
  1. S $P(^PXRMXT(810.3,0),U,3)=CNT,$P(^PXRMXT(810.3,0),U,4)=COUNT
  1. ;Save Task and extract parameters
  1. S ^PXRMXT(810.3,CNT,0)=DESC_U_PXRMBDT_U_PXRMEDT_U_$G(ZTSK)_U_DUZ_U_$$NOW^XLFDT_U_PXRMCNT_U_PXRMFCNT
  1. S $P(^PXRMXT(810.3,CNT,50),U)=1
  1. S $P(^PXRMXT(810.3,CNT,100),U)="N"
  1. ;Transfer findings into report file
  1. N DATE,DFN,DRUG,DSUP,ENC,EREC,ETYP,IC,FINDING,RESULT
  1. N TERM,ALTTRM,TIEN,TNDBID,VALUE,VIEN
  1. S DFN=0,CN1=0
  1. F S DFN=$O(^TMP(NODE,$J,DFN)) Q:'DFN Q:TSTOP=1 D
  1. .;Check if stop task requested
  1. .I $$S^%ZTLOAD S TSTOP=1 Q
  1. .S ENC=0
  1. .F S ENC=$O(^TMP(NODE,$J,DFN,"FIND",ENC)) Q:'ENC D
  1. ..;DINUM
  1. ..S CN1=CN1+1
  1. ..;Encounter type
  1. ..S ETYP=$P($G(^TMP(NODE,$J,DFN,"FIND",ENC)),U,2)
  1. ..;Finding details
  1. ..F IC="DATE","FINDING","RESULT","TERM","ALTTRM","VALUE","VIEN" D
  1. ...S @IC=$P($G(^TMP(NODE,$J,DFN,"FIND",ENC,IC)),U)
  1. ..;Drug details
  1. ..F IC="DRUG","DSUP" D
  1. ...S @IC=$P($G(^TMP(NODE,$J,DFN,"FIND",ENC,IC)),U)
  1. ..;Get the term ien for the original term if a mapping occurred
  1. ..S TIEN="",TNDBID=""
  1. ..I TERM]"" S TIEN=$O(^PXRMD(811.5,"B",TERM,"")),TNDBID=ALTTRM
  1. ..;Save value if the result is null
  1. ..I RESULT="" S RESULT=VALUE
  1. ..;Save data to file
  1. ..S EREC=DFN_U_U_TIEN_U_FINDING_U_TNDBID_U_DATE_U_VIEN_U_ETYP
  1. ..S ^PXRMXT(810.3,CNT,1,CN1,0)=EREC
  1. ..S EREC=RESULT_U_VALUE_U_DRUG_U_DSUP
  1. ..S ^PXRMXT(810.3,CNT,1,CN1,1)=EREC
  1. ;
  1. ;Set top node for ^DIK re-index
  1. S ^PXRMXT(810.3,CNT,1,0)="^810.31A^"_CN1_U_CN1
  1. ;
  1. ;Write finding totals to report file
  1. N FCNT,FUNIQ,FIEN,FFIEN
  1. S FIEN="",CN1=0
  1. F S FIEN=$O(PXRMFIEN(FIEN)) Q:FIEN="" D
  1. .S FCNT=+$P(PXRMFIEN(FIEN),U),FUNIQ=+$P(PXRMFIEN(FIEN),U,2)
  1. .S FFIEN=FIEN I FFIEN="NO FINDING" S FFIEN=""
  1. .S CN1=CN1+1,^PXRMXT(810.3,CNT,2,CN1,0)=FFIEN_U_FCNT_U_FUNIQ
  1. ;
  1. ;Set top node for ^DIK re-index
  1. S ^PXRMXT(810.3,CNT,2,0)="^810.32A^"_CN1_U_CN1
  1. ;
  1. ;Re-index the file for this batch
  1. N DIK,DA
  1. S DIK="^PXRMXT(810.3,",DA=CNT
  1. D IX1^DIK
  1. ;
  1. Q
  1. ;
  1. ;Store finding for term
  1. ;----------------------
  1. RSET N FIEN
  1. S FIEN=""
  1. F S FIEN=$O(^PXRMD(811.5,TIEN,20,"E",FTYPE,FIEN)) Q:'FIEN D
  1. .S OUTPUT(FTYPE,FIEN,TIEN)=""
  1. Q
  1. ;
  1. ;Store the taxonomy ICD9 codes
  1. ;-----------------------------
  1. RTAX N FIEN,ISUB,TXIEN
  1. S TXIEN=""
  1. ;Scan taxonomy section of the term
  1. F S TXIEN=$O(^PXRMD(811.5,TIEN,20,"E",FTYPE,TXIEN)) Q:'TXIEN D
  1. .S ISUB=""
  1. .;Extract ICD9 codes from expanded taxonomy file
  1. .F S ISUB=$O(^PXD(811.3,TXIEN,80,ISUB)) Q:'ISUB D
  1. ..S FIEN=$P($G(^PXD(811.3,TXIEN,80,ISUB,0)),U) Q:'FIEN
  1. ..S OUTPUT("ICD9(",FIEN,TIEN)=""
  1. Q