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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXX1 6203 printed Apr 09, 2024@20:49:46 Page 2
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
