- PXRMXX1 ; SLC/PJH - Build list of reminder findings;08/03/2005
- ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
- ;
- ;Called at REM, REPORT and PSMERG from PXRMXX
- ;
- ;Merge the patients found by the pharmacy API
- ;--------------------------------------------
- PSMERG(TYP,NODE,SEARCH) ;
- N DATA,DATE,DCNT,DFN,DRUG,DSUP,FCNT,FINDING,FIEN,FLD,FTYP,FREC,FUNIQ
- N LAST,LDATE,NEXT,RDATE,SDATE,STOPDATE,TERM,TIEN,VTYP
- ;
- S DFN="",VTYP=$S(TYP="PXRMPSI":"I",1:"O")
- F S DFN=$O(^TMP(TYP_NODE,$J,DFN)) Q:'DFN D
- .;Get last entry for this patient created by reminder evaluation
- .S LAST=$O(^TMP(NODE,$J,DFN,"FIND",""),-1),NEXT=LAST+1,DCNT=0
- .;If this is a new patient update patient and finding count
- .I NEXT=1 S PXRMFCNT=PXRMFCNT+1,PXRMCNT=PXRMCNT+1
- .;Scan through medications found for this patient
- .F S DCNT=$O(^TMP(TYP_NODE,$J,DFN,DCNT)) Q:'DCNT D
- ..;Move data fields into FIEVAL format
- ..S FINDING=$P($G(^TMP(TYP_NODE,$J,DFN,DCNT,0)),U) Q:FINDING=""
- ..S DATA=$G(^TMP(TYP_NODE,$J,DFN,DCNT,1)),DATE=$P(DATA,U)
- ..S RDATE=$P(DATA,U,2),DRUG=$P(DATA,U,3),DSUP=$P(DATA,U,4)
- ..;Stop date
- ..S STOPDATE=$P(DATA,U,5)
- ..I +STOPDATE S DSUP=$$FMDIFF^XLFDT(STOPDATE,DATE,"")
- ..;Determine finding item/type
- ..S FTYPE=$P(FINDING,";",2),FIEN=$P(FINDING,";") Q:FIEN="" Q:FTYPE=""
- ..;Create file entry for each term
- ..S TIEN=""
- ..F S TIEN=$O(SEARCH(FTYPE,FIEN,TIEN)) Q:TIEN="" D
- ...F FLD="FINDING","DATE","RDATE","DRUG","DSUP","STOPDATE" D
- ....S ^TMP(NODE,$J,DFN,"FIND",NEXT,FLD)=@FLD
- ...;Get term name (no transforms)
- ...S ^TMP(NODE,$J,DFN,"FIND",NEXT,"TERM")=$P($G(^PXRMD(811.5,TIEN,0)),U)
- ...;Update header
- ...S ^TMP(NODE,$J,DFN,"FIND",NEXT)=DATE_U_VTYP
- ...;Update finding header
- ...S LDATE=$P($G(^TMP(NODE,$J,DFN)),U)
- ...I DATE>LDATE S ^TMP(NODE,$J,DFN)=DATE_U_VTYP
- ...;Save count by finding for report
- ...S FREC=$G(PXRMFIEN(FINDING)),FCNT=$P(FREC,U),FUNIQ=$P(FREC,U,2)
- ...S FCNT=FCNT+1 I '$G(FUNIQ(FIEN)) S FUNIQ=FUNIQ+1
- ...S PXRMFIEN(FINDING)=FCNT_U_FUNIQ,FUNIQ(FINDING)=1
- ...;Update count
- ...S NEXT=NEXT+1
- Q
- ;
- ;Build list of related findings
- ;------------------------------
- REM(PXRMITEM,OUTPUT,LAB) ;
- N COHORT,FTYPE,FIEN,FNODE,TNAM,TIEN
- S FTYPE=""
- ;Check if terms findings exist on the reminder
- F S FTYPE=$O(^PXD(811.9,PXRMITEM,20,"E",FTYPE)) Q:FTYPE="" D
- .;Check terms ONLY
- .I FTYPE="PXRMD(811.5," D Q
- ..N FTYPE S TIEN=""
- ..;Scan through terms in this reminder
- ..F S TIEN=$O(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,",TIEN)) Q:'TIEN D
- ...;Get the cohort flag
- ...S FNODE=$O(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,",TIEN,""))
- ...S COHORT="",FTYPE=""
- ...I FNODE S COHORT=$P($G(^PXD(811.9,PXRMITEM,20,FNODE,0)),U,7)
- ...;Scan through term looking for findings
- ...F S FTYPE=$O(^PXRMD(811.5,TIEN,20,"E",FTYPE)) Q:FTYPE="" D
- ....;Taxonomy findings
- ....I FTYPE="PXD(811.2," D RTAX Q
- ....;If Lab test and not in cohort ignore
- ....I FTYPE="LAB(60,",COHORT="" D Q
- .....;Only applies to lab extract reminder
- .....I $G(REM(PXRMITEM))'="VA-NATIONAL EPI LAB EXTRACT" Q
- .....;Get the term name for this lab test
- .....S TNAM=$P($G(^PXRMD(811.5,TIEN,0)),U) Q:TNAM=""
- .....S LAB(TNAM)=TIEN Q
- ....;Other findings
- ....D RSET
- Q
- ;
- ;Save report details
- ;-------------------
- REPORT(NODE) ;
- N RDATE,CNT,CN1,COUNT,DATA,LAST,OLD,DESC
- ;format rundate as MMDDYY
- S RDATE=$$DT^XLFDT,RDATE=$E(RDATE,4,5)_$E(RDATE,6,7)_$E(RDATE,2,3)
- ;Task Name
- S DESC="LREPI "_$E(PXRMEDT,2,3)_"/"_$E(PXRMEDT,4,5)_" "_RDATE
- S DATA=$G(^PXRMXT(810.3,0))
- ;Find next entry in report file
- S LAST=$P(DATA,U,3),COUNT=$P(DATA,U,4)+1,CNT=LAST+1
- S $P(^PXRMXT(810.3,0),U,3)=CNT,$P(^PXRMXT(810.3,0),U,4)=COUNT
- ;Save Task and extract parameters
- S ^PXRMXT(810.3,CNT,0)=DESC_U_PXRMBDT_U_PXRMEDT_U_$G(ZTSK)_U_DUZ_U_$$NOW^XLFDT_U_PXRMCNT_U_PXRMFCNT
- S $P(^PXRMXT(810.3,CNT,50),U)=1
- S $P(^PXRMXT(810.3,CNT,100),U)="N"
- ;Transfer findings into report file
- N DATE,DFN,DRUG,DSUP,ENC,EREC,ETYP,IC,FINDING,RESULT
- N TERM,ALTTRM,TIEN,TNDBID,VALUE,VIEN
- S DFN=0,CN1=0
- F S DFN=$O(^TMP(NODE,$J,DFN)) Q:'DFN Q:TSTOP=1 D
- .;Check if stop task requested
- .I $$S^%ZTLOAD S TSTOP=1 Q
- .S ENC=0
- .F S ENC=$O(^TMP(NODE,$J,DFN,"FIND",ENC)) Q:'ENC D
- ..;DINUM
- ..S CN1=CN1+1
- ..;Encounter type
- ..S ETYP=$P($G(^TMP(NODE,$J,DFN,"FIND",ENC)),U,2)
- ..;Finding details
- ..F IC="DATE","FINDING","RESULT","TERM","ALTTRM","VALUE","VIEN" D
- ...S @IC=$P($G(^TMP(NODE,$J,DFN,"FIND",ENC,IC)),U)
- ..;Drug details
- ..F IC="DRUG","DSUP" D
- ...S @IC=$P($G(^TMP(NODE,$J,DFN,"FIND",ENC,IC)),U)
- ..;Get the term ien for the original term if a mapping occurred
- ..S TIEN="",TNDBID=""
- ..I TERM]"" S TIEN=$O(^PXRMD(811.5,"B",TERM,"")),TNDBID=ALTTRM
- ..;Save value if the result is null
- ..I RESULT="" S RESULT=VALUE
- ..;Save data to file
- ..S EREC=DFN_U_U_TIEN_U_FINDING_U_TNDBID_U_DATE_U_VIEN_U_ETYP
- ..S ^PXRMXT(810.3,CNT,1,CN1,0)=EREC
- ..S EREC=RESULT_U_VALUE_U_DRUG_U_DSUP
- ..S ^PXRMXT(810.3,CNT,1,CN1,1)=EREC
- ;
- ;Set top node for ^DIK re-index
- S ^PXRMXT(810.3,CNT,1,0)="^810.31A^"_CN1_U_CN1
- ;
- ;Write finding totals to report file
- N FCNT,FUNIQ,FIEN,FFIEN
- S FIEN="",CN1=0
- F S FIEN=$O(PXRMFIEN(FIEN)) Q:FIEN="" D
- .S FCNT=+$P(PXRMFIEN(FIEN),U),FUNIQ=+$P(PXRMFIEN(FIEN),U,2)
- .S FFIEN=FIEN I FFIEN="NO FINDING" S FFIEN=""
- .S CN1=CN1+1,^PXRMXT(810.3,CNT,2,CN1,0)=FFIEN_U_FCNT_U_FUNIQ
- ;
- ;Set top node for ^DIK re-index
- S ^PXRMXT(810.3,CNT,2,0)="^810.32A^"_CN1_U_CN1
- ;
- ;Re-index the file for this batch
- N DIK,DA
- S DIK="^PXRMXT(810.3,",DA=CNT
- D IX1^DIK
- ;
- Q
- ;
- ;Store finding for term
- ;----------------------
- RSET N FIEN
- S FIEN=""
- F S FIEN=$O(^PXRMD(811.5,TIEN,20,"E",FTYPE,FIEN)) Q:'FIEN D
- .S OUTPUT(FTYPE,FIEN,TIEN)=""
- Q
- ;
- ;Store the taxonomy ICD9 codes
- ;-----------------------------
- RTAX N FIEN,ISUB,TXIEN
- S TXIEN=""
- ;Scan taxonomy section of the term
- F S TXIEN=$O(^PXRMD(811.5,TIEN,20,"E",FTYPE,TXIEN)) Q:'TXIEN D
- .S ISUB=""
- .;Extract ICD9 codes from expanded taxonomy file
- .F S ISUB=$O(^PXD(811.3,TXIEN,80,ISUB)) Q:'ISUB D
- ..S FIEN=$P($G(^PXD(811.3,TXIEN,80,ISUB,0)),U) Q:'FIEN
- ..S OUTPUT("ICD9(",FIEN,TIEN)=""
- Q
- PXRMXX1 ; SLC/PJH - Build list of reminder findings;08/03/2005
- +1 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
- +2 ;
- +3 ;Called at REM, REPORT and PSMERG from PXRMXX
- +4 ;
- +5 ;Merge the patients found by the pharmacy API
- +6 ;--------------------------------------------
- PSMERG(TYP,NODE,SEARCH) ;
- +1 NEW DATA,DATE,DCNT,DFN,DRUG,DSUP,FCNT,FINDING,FIEN,FLD,FTYP,FREC,FUNIQ
- +2 NEW LAST,LDATE,NEXT,RDATE,SDATE,STOPDATE,TERM,TIEN,VTYP
- +3 ;
- +4 SET DFN=""
- SET VTYP=$SELECT(TYP="PXRMPSI":"I",1:"O")
- +5 FOR
- SET DFN=$ORDER(^TMP(TYP_NODE,$JOB,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +6 ;Get last entry for this patient created by reminder evaluation
- +7 SET LAST=$ORDER(^TMP(NODE,$JOB,DFN,"FIND",""),-1)
- SET NEXT=LAST+1
- SET DCNT=0
- +8 ;If this is a new patient update patient and finding count
- +9 IF NEXT=1
- SET PXRMFCNT=PXRMFCNT+1
- SET PXRMCNT=PXRMCNT+1
- +10 ;Scan through medications found for this patient
- +11 FOR
- SET DCNT=$ORDER(^TMP(TYP_NODE,$JOB,DFN,DCNT))
- IF 'DCNT
- QUIT
- Begin DoDot:2
- +12 ;Move data fields into FIEVAL format
- +13 SET FINDING=$PIECE($GET(^TMP(TYP_NODE,$JOB,DFN,DCNT,0)),U)
- IF FINDING=""
- QUIT
- +14 SET DATA=$GET(^TMP(TYP_NODE,$JOB,DFN,DCNT,1))
- SET DATE=$PIECE(DATA,U)
- +15 SET RDATE=$PIECE(DATA,U,2)
- SET DRUG=$PIECE(DATA,U,3)
- SET DSUP=$PIECE(DATA,U,4)
- +16 ;Stop date
- +17 SET STOPDATE=$PIECE(DATA,U,5)
- +18 IF +STOPDATE
- SET DSUP=$$FMDIFF^XLFDT(STOPDATE,DATE,"")
- +19 ;Determine finding item/type
- +20 SET FTYPE=$PIECE(FINDING,";",2)
- SET FIEN=$PIECE(FINDING,";")
- IF FIEN=""
- QUIT
- IF FTYPE=""
- QUIT
- +21 ;Create file entry for each term
- +22 SET TIEN=""
- +23 FOR
- SET TIEN=$ORDER(SEARCH(FTYPE,FIEN,TIEN))
- IF TIEN=""
- QUIT
- Begin DoDot:3
- +24 FOR FLD="FINDING","DATE","RDATE","DRUG","DSUP","STOPDATE"
- Begin DoDot:4
- +25 SET ^TMP(NODE,$JOB,DFN,"FIND",NEXT,FLD)=@FLD
- End DoDot:4
- +26 ;Get term name (no transforms)
- +27 SET ^TMP(NODE,$JOB,DFN,"FIND",NEXT,"TERM")=$PIECE($GET(^PXRMD(811.5,TIEN,0)),U)
- +28 ;Update header
- +29 SET ^TMP(NODE,$JOB,DFN,"FIND",NEXT)=DATE_U_VTYP
- +30 ;Update finding header
- +31 SET LDATE=$PIECE($GET(^TMP(NODE,$JOB,DFN)),U)
- +32 IF DATE>LDATE
- SET ^TMP(NODE,$JOB,DFN)=DATE_U_VTYP
- +33 ;Save count by finding for report
- +34 SET FREC=$GET(PXRMFIEN(FINDING))
- SET FCNT=$PIECE(FREC,U)
- SET FUNIQ=$PIECE(FREC,U,2)
- +35 SET FCNT=FCNT+1
- IF '$GET(FUNIQ(FIEN))
- SET FUNIQ=FUNIQ+1
- +36 SET PXRMFIEN(FINDING)=FCNT_U_FUNIQ
- SET FUNIQ(FINDING)=1
- +37 ;Update count
- +38 SET NEXT=NEXT+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +39 QUIT
- +40 ;
- +41 ;Build list of related findings
- +42 ;------------------------------
- REM(PXRMITEM,OUTPUT,LAB) ;
- +1 NEW COHORT,FTYPE,FIEN,FNODE,TNAM,TIEN
- +2 SET FTYPE=""
- +3 ;Check if terms findings exist on the reminder
- +4 FOR
- SET FTYPE=$ORDER(^PXD(811.9,PXRMITEM,20,"E",FTYPE))
- IF FTYPE=""
- QUIT
- Begin DoDot:1
- +5 ;Check terms ONLY
- +6 IF FTYPE="PXRMD(811.5,"
- Begin DoDot:2
- +7 NEW FTYPE
- SET TIEN=""
- +8 ;Scan through terms in this reminder
- +9 FOR
- SET TIEN=$ORDER(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,",TIEN))
- IF 'TIEN
- QUIT
- Begin DoDot:3
- +10 ;Get the cohort flag
- +11 SET FNODE=$ORDER(^PXD(811.9,PXRMITEM,20,"E","PXRMD(811.5,",TIEN,""))
- +12 SET COHORT=""
- SET FTYPE=""
- +13 IF FNODE
- SET COHORT=$PIECE($GET(^PXD(811.9,PXRMITEM,20,FNODE,0)),U,7)
- +14 ;Scan through term looking for findings
- +15 FOR
- SET FTYPE=$ORDER(^PXRMD(811.5,TIEN,20,"E",FTYPE))
- IF FTYPE=""
- QUIT
- Begin DoDot:4
- +16 ;Taxonomy findings
- +17 IF FTYPE="PXD(811.2,"
- DO RTAX
- QUIT
- +18 ;If Lab test and not in cohort ignore
- +19 IF FTYPE="LAB(60,"
- IF COHORT=""
- Begin DoDot:5
- +20 ;Only applies to lab extract reminder
- +21 IF $GET(REM(PXRMITEM))'="VA-NATIONAL EPI LAB EXTRACT"
- QUIT
- +22 ;Get the term name for this lab test
- +23 SET TNAM=$PIECE($GET(^PXRMD(811.5,TIEN,0)),U)
- IF TNAM=""
- QUIT
- +24 SET LAB(TNAM)=TIEN
- QUIT
- End DoDot:5
- QUIT
- +25 ;Other findings
- +26 DO RSET
- End DoDot:4
- End DoDot:3
- End DoDot:2
- QUIT
- End DoDot:1
- +27 QUIT
- +28 ;
- +29 ;Save report details
- +30 ;-------------------
- REPORT(NODE) ;
- +1 NEW RDATE,CNT,CN1,COUNT,DATA,LAST,OLD,DESC
- +2 ;format rundate as MMDDYY
- +3 SET RDATE=$$DT^XLFDT
- SET RDATE=$EXTRACT(RDATE,4,5)_$EXTRACT(RDATE,6,7)_$EXTRACT(RDATE,2,3)
- +4 ;Task Name
- +5 SET DESC="LREPI "_$EXTRACT(PXRMEDT,2,3)_"/"_$EXTRACT(PXRMEDT,4,5)_" "_RDATE
- +6 SET DATA=$GET(^PXRMXT(810.3,0))
- +7 ;Find next entry in report file
- +8 SET LAST=$PIECE(DATA,U,3)
- SET COUNT=$PIECE(DATA,U,4)+1
- SET CNT=LAST+1
- +9 SET $PIECE(^PXRMXT(810.3,0),U,3)=CNT
- SET $PIECE(^PXRMXT(810.3,0),U,4)=COUNT
- +10 ;Save Task and extract parameters
- +11 SET ^PXRMXT(810.3,CNT,0)=DESC_U_PXRMBDT_U_PXRMEDT_U_$GET(ZTSK)_U_DUZ_U_$$NOW^XLFDT_U_PXRMCNT_U_PXRMFCNT
- +12 SET $PIECE(^PXRMXT(810.3,CNT,50),U)=1
- +13 SET $PIECE(^PXRMXT(810.3,CNT,100),U)="N"
- +14 ;Transfer findings into report file
- +15 NEW DATE,DFN,DRUG,DSUP,ENC,EREC,ETYP,IC,FINDING,RESULT
- +16 NEW TERM,ALTTRM,TIEN,TNDBID,VALUE,VIEN
- +17 SET DFN=0
- SET CN1=0
- +18 FOR
- SET DFN=$ORDER(^TMP(NODE,$JOB,DFN))
- IF 'DFN
- QUIT
- IF TSTOP=1
- QUIT
- Begin DoDot:1
- +19 ;Check if stop task requested
- +20 IF $$S^%ZTLOAD
- SET TSTOP=1
- QUIT
- +21 SET ENC=0
- +22 FOR
- SET ENC=$ORDER(^TMP(NODE,$JOB,DFN,"FIND",ENC))
- IF 'ENC
- QUIT
- Begin DoDot:2
- +23 ;DINUM
- +24 SET CN1=CN1+1
- +25 ;Encounter type
- +26 SET ETYP=$PIECE($GET(^TMP(NODE,$JOB,DFN,"FIND",ENC)),U,2)
- +27 ;Finding details
- +28 FOR IC="DATE","FINDING","RESULT","TERM","ALTTRM","VALUE","VIEN"
- Begin DoDot:3
- +29 SET @IC=$PIECE($GET(^TMP(NODE,$JOB,DFN,"FIND",ENC,IC)),U)
- End DoDot:3
- +30 ;Drug details
- +31 FOR IC="DRUG","DSUP"
- Begin DoDot:3
- +32 SET @IC=$PIECE($GET(^TMP(NODE,$JOB,DFN,"FIND",ENC,IC)),U)
- End DoDot:3
- +33 ;Get the term ien for the original term if a mapping occurred
- +34 SET TIEN=""
- SET TNDBID=""
- +35 IF TERM]""
- SET TIEN=$ORDER(^PXRMD(811.5,"B",TERM,""))
- SET TNDBID=ALTTRM
- +36 ;Save value if the result is null
- +37 IF RESULT=""
- SET RESULT=VALUE
- +38 ;Save data to file
- +39 SET EREC=DFN_U_U_TIEN_U_FINDING_U_TNDBID_U_DATE_U_VIEN_U_ETYP
- +40 SET ^PXRMXT(810.3,CNT,1,CN1,0)=EREC
- +41 SET EREC=RESULT_U_VALUE_U_DRUG_U_DSUP
- +42 SET ^PXRMXT(810.3,CNT,1,CN1,1)=EREC
- End DoDot:2
- End DoDot:1
- +43 ;
- +44 ;Set top node for ^DIK re-index
- +45 SET ^PXRMXT(810.3,CNT,1,0)="^810.31A^"_CN1_U_CN1
- +46 ;
- +47 ;Write finding totals to report file
- +48 NEW FCNT,FUNIQ,FIEN,FFIEN
- +49 SET FIEN=""
- SET CN1=0
- +50 FOR
- SET FIEN=$ORDER(PXRMFIEN(FIEN))
- IF FIEN=""
- QUIT
- Begin DoDot:1
- +51 SET FCNT=+$PIECE(PXRMFIEN(FIEN),U)
- SET FUNIQ=+$PIECE(PXRMFIEN(FIEN),U,2)
- +52 SET FFIEN=FIEN
- IF FFIEN="NO FINDING"
- SET FFIEN=""
- +53 SET CN1=CN1+1
- SET ^PXRMXT(810.3,CNT,2,CN1,0)=FFIEN_U_FCNT_U_FUNIQ
- End DoDot:1
- +54 ;
- +55 ;Set top node for ^DIK re-index
- +56 SET ^PXRMXT(810.3,CNT,2,0)="^810.32A^"_CN1_U_CN1
- +57 ;
- +58 ;Re-index the file for this batch
- +59 NEW DIK,DA
- +60 SET DIK="^PXRMXT(810.3,"
- SET DA=CNT
- +61 DO IX1^DIK
- +62 ;
- +63 QUIT
- +64 ;
- +65 ;Store finding for term
- +66 ;----------------------
- RSET NEW FIEN
- +1 SET FIEN=""
- +2 FOR
- SET FIEN=$ORDER(^PXRMD(811.5,TIEN,20,"E",FTYPE,FIEN))
- IF 'FIEN
- QUIT
- Begin DoDot:1
- +3 SET OUTPUT(FTYPE,FIEN,TIEN)=""
- End DoDot:1
- +4 QUIT
- +5 ;
- +6 ;Store the taxonomy ICD9 codes
- +7 ;-----------------------------
- RTAX NEW FIEN,ISUB,TXIEN
- +1 SET TXIEN=""
- +2 ;Scan taxonomy section of the term
- +3 FOR
- SET TXIEN=$ORDER(^PXRMD(811.5,TIEN,20,"E",FTYPE,TXIEN))
- IF 'TXIEN
- QUIT
- Begin DoDot:1
- +4 SET ISUB=""
- +5 ;Extract ICD9 codes from expanded taxonomy file
- +6 FOR
- SET ISUB=$ORDER(^PXD(811.3,TXIEN,80,ISUB))
- IF 'ISUB
- QUIT
- Begin DoDot:2
- +7 SET FIEN=$PIECE($GET(^PXD(811.3,TXIEN,80,ISUB,0)),U)
- IF 'FIEN
- QUIT
- +8 SET OUTPUT("ICD9(",FIEN,TIEN)=""
- End DoDot:2
- End DoDot:1
- +9 QUIT