- BPXRMRAD ; IHS/MSC/MGH - Use V RAD in reminder resolution. ;25-Nov-2013 14:52;DU
- ;;2.0;CLINICAL REMINDERS;**1001**;Feb 04, 2005;Build 21
- ;===================================================================
- VRAD(DFN,TEST,DATE,VALUE,TEXT) ;EP
- N BPXTRM
- Q:TEST=""
- S BPXTRM="" S BPXTRM=$O(^PXRMD(811.5,"B",TEST,BPXTRM))
- I BPXTRM="" S TEST=0,DATE=DT,TEXT="Reminder term does not exist" Q
- D GETVAR(BPXTRM)
- Q
- GETVAR(BPXTRM) ;EP
- ;Get the needed data from the reminder term. This includes
- ;the test name(s) and the value to search for
- N X,Y,BPXFIND,BPXTYPE,BPXOFF,BPXFILE,BPXRESLT,BPXCNT,BPXTEST
- K ^TMP("PXRMRAD",$J)
- S BPXCNT=0,BPXRESLT=0
- S BPXFIND=0 F S BPXFIND=$O(^PXRMD(811.5,BPXTRM,20,BPXFIND)) Q:BPXFIND=""!(BPXFIND?1A.A)!(BPXRESLT=1) D
- .S BPXTYPE=$P($G(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,1)
- .S BPXTEST=$P(BPXTYPE,";",1),BPXFILE=$P(BPXTYPE,";",2)
- .;This needs to be a term of laboratory tests
- .Q:BPXFILE'="RAMIS(71,"
- .S BPXOFF=$P($G(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,8)
- .;Call next routine with patient,start and stop dates,test name
- .D RESULT(DFN,BPXTEST)
- ;Loop through results and return most recent
- S BPXRESLT="" S BPXRESLT=$O(^TMP("PXRMRAD",$J,BPXRESLT))
- I BPXRESLT="" S TEST=0,VALUE=TEST
- I +BPXRESLT D
- .S TEST=1,VALUE=$P($G(^TMP("PXRMRAD",$J,BPXRESLT)),U,2)
- .S DATE=$P($G(^TMP("PXRMRAD",$J,BPXRESLT)),U,1)
- .S TEXT=$P($G(^TMP("PXRMRAD",$J,BPXRESLT)),U,3)
- Q
- RESULT(DFN,RADIEN) ;EP
- ;EP Find a patients labs in the V LAB file
- ;Get up to ten results of the specified lab test
- ;If the result has an associated LR ACCESSION NUMBER quit
- ;If not, add it to the array to be used in the reminder
- ;===================================================================
- N VRIEN,INVDATE,TEMP,RADPROC,COUNT
- S VRIEN="",COUNT=0
- Q:'$D(^AUPNVRAD("AC",DFN))
- F S VRIEN=$O(^AUPNVRAD("AC",DFN,VRIEN)) Q:VRIEN=""!(COUNT>10) D
- .S RADPROC=$P($G(^AUPNVRAD(VRIEN,0)),U,1)
- .I RADPROC=RADIEN D STORE
- Q
- STORE ;Store the needed data into TMP for use in reminders
- N FLAG,UNITS,ORDER,TEMP,TEMP1,TEMP2,VIS,VDATE,Y,INVDATE,PROC,STATUS
- S COUNT=COUNT+1
- S TEMP=$G(^AUPNVRAD(VRIEN,0)),TEMP1=$G(^AUPNVRAD(VRIEN,11))
- S TEMP2=$G(^AUPNVRAD(VRIEN,12))
- I TEMP1'="" S ORDER="COMPLETE",STATUS="COMPLETE"
- I TEMP1="" S ORDER="IN PROGRESS",STATUS="IN PROGRESS"
- S PROC=$$GET1^DIQ(9000010.22,VRIEN,.01)
- I $P(TEMP2,U,1)="" D
- .S VIS=$P($G(^AUPNVRAD(VRIEN,0)),U,3)
- .Q:VIS=""
- .S VDATE=$P($G(^AUPNVSIT(VIS,0)),U,1)
- .S Y=VDATE
- E S Y=$P(TEMP2,U,1)
- S INVDATE=9999999-Y
- S ^TMP("PXRMRAD",$J,INVDATE)=Y_U_PROC_U_STATUS
- Q
- BPXRMRAD ; IHS/MSC/MGH - Use V RAD in reminder resolution. ;25-Nov-2013 14:52;DU
- +1 ;;2.0;CLINICAL REMINDERS;**1001**;Feb 04, 2005;Build 21
- +2 ;===================================================================
- VRAD(DFN,TEST,DATE,VALUE,TEXT) ;EP
- +1 NEW BPXTRM
- +2 IF TEST=""
- QUIT
- +3 SET BPXTRM=""
- SET BPXTRM=$ORDER(^PXRMD(811.5,"B",TEST,BPXTRM))
- +4 IF BPXTRM=""
- SET TEST=0
- SET DATE=DT
- SET TEXT="Reminder term does not exist"
- QUIT
- +5 DO GETVAR(BPXTRM)
- +6 QUIT
- GETVAR(BPXTRM) ;EP
- +1 ;Get the needed data from the reminder term. This includes
- +2 ;the test name(s) and the value to search for
- +3 NEW X,Y,BPXFIND,BPXTYPE,BPXOFF,BPXFILE,BPXRESLT,BPXCNT,BPXTEST
- +4 KILL ^TMP("PXRMRAD",$JOB)
- +5 SET BPXCNT=0
- SET BPXRESLT=0
- +6 SET BPXFIND=0
- FOR
- SET BPXFIND=$ORDER(^PXRMD(811.5,BPXTRM,20,BPXFIND))
- IF BPXFIND=""!(BPXFIND?1A.A)!(BPXRESLT=1)
- QUIT
- Begin DoDot:1
- +7 SET BPXTYPE=$PIECE($GET(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,1)
- +8 SET BPXTEST=$PIECE(BPXTYPE,";",1)
- SET BPXFILE=$PIECE(BPXTYPE,";",2)
- +9 ;This needs to be a term of laboratory tests
- +10 IF BPXFILE'="RAMIS(71,"
- QUIT
- +11 SET BPXOFF=$PIECE($GET(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,8)
- +12 ;Call next routine with patient,start and stop dates,test name
- +13 DO RESULT(DFN,BPXTEST)
- End DoDot:1
- +14 ;Loop through results and return most recent
- +15 SET BPXRESLT=""
- SET BPXRESLT=$ORDER(^TMP("PXRMRAD",$JOB,BPXRESLT))
- +16 IF BPXRESLT=""
- SET TEST=0
- SET VALUE=TEST
- +17 IF +BPXRESLT
- Begin DoDot:1
- +18 SET TEST=1
- SET VALUE=$PIECE($GET(^TMP("PXRMRAD",$JOB,BPXRESLT)),U,2)
- +19 SET DATE=$PIECE($GET(^TMP("PXRMRAD",$JOB,BPXRESLT)),U,1)
- +20 SET TEXT=$PIECE($GET(^TMP("PXRMRAD",$JOB,BPXRESLT)),U,3)
- End DoDot:1
- +21 QUIT
- RESULT(DFN,RADIEN) ;EP
- +1 ;EP Find a patients labs in the V LAB file
- +2 ;Get up to ten results of the specified lab test
- +3 ;If the result has an associated LR ACCESSION NUMBER quit
- +4 ;If not, add it to the array to be used in the reminder
- +5 ;===================================================================
- +6 NEW VRIEN,INVDATE,TEMP,RADPROC,COUNT
- +7 SET VRIEN=""
- SET COUNT=0
- +8 IF '$DATA(^AUPNVRAD("AC",DFN))
- QUIT
- +9 FOR
- SET VRIEN=$ORDER(^AUPNVRAD("AC",DFN,VRIEN))
- IF VRIEN=""!(COUNT>10)
- QUIT
- Begin DoDot:1
- +10 SET RADPROC=$PIECE($GET(^AUPNVRAD(VRIEN,0)),U,1)
- +11 IF RADPROC=RADIEN
- DO STORE
- End DoDot:1
- +12 QUIT
- STORE ;Store the needed data into TMP for use in reminders
- +1 NEW FLAG,UNITS,ORDER,TEMP,TEMP1,TEMP2,VIS,VDATE,Y,INVDATE,PROC,STATUS
- +2 SET COUNT=COUNT+1
- +3 SET TEMP=$GET(^AUPNVRAD(VRIEN,0))
- SET TEMP1=$GET(^AUPNVRAD(VRIEN,11))
- +4 SET TEMP2=$GET(^AUPNVRAD(VRIEN,12))
- +5 IF TEMP1'=""
- SET ORDER="COMPLETE"
- SET STATUS="COMPLETE"
- +6 IF TEMP1=""
- SET ORDER="IN PROGRESS"
- SET STATUS="IN PROGRESS"
- +7 SET PROC=$$GET1^DIQ(9000010.22,VRIEN,.01)
- +8 IF $PIECE(TEMP2,U,1)=""
- Begin DoDot:1
- +9 SET VIS=$PIECE($GET(^AUPNVRAD(VRIEN,0)),U,3)
- +10 IF VIS=""
- QUIT
- +11 SET VDATE=$PIECE($GET(^AUPNVSIT(VIS,0)),U,1)
- +12 SET Y=VDATE
- End DoDot:1
- +13 IF '$TEST
- SET Y=$PIECE(TEMP2,U,1)
- +14 SET INVDATE=9999999-Y
- +15 SET ^TMP("PXRMRAD",$JOB,INVDATE)=Y_U_PROC_U_STATUS
- +16 QUIT
