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

WVALERTS.m

Go to the documentation of this file.
  1. WVALERTS ;HIOFO/FT-WV ALERTS APIs ;2/19/04 13:56
  1. ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
  1. ;
  1. ; This routine uses the following IAs:
  1. ; #2480 - ^RADPT references (private)
  1. ; #2770 - ^GMTSLRPE calls and ^TMP("LRCY" references (private)
  1. ; #2771 - ^GMTSLRAE calls and ^TMP("LRA" references (private)
  1. ;
  1. ; This routine supports the following IAs:
  1. ; RESULTS - 4102
  1. ;
  1. ;
  1. UPDATE(WVIEN) ; Updates the FILE 790.1 entry identified in WVIEN to
  1. ; show it was processed by a Clinical Reminder.
  1. ; Input: WVIEN - FILE 790.1 IEN
  1. ; Output: <none>
  1. Q:'$G(WVIEN)
  1. N WVDXFLAG,WVERR,WVFAC,WVFDA
  1. I '$D(^WV(790.1,WVIEN,0)) Q
  1. ; Check 'update results/dx?' parameter
  1. S WVFAC=+$P($G(^WV(790.1,+WVIEN,0)),U,10)
  1. S WVDXFLAG=$P($G(^WV(790.02,+WVFAC,0)),U,11)
  1. Q:'WVDXFLAG
  1. S WVFDA(790.1,WVIEN_",",.16)=1
  1. D FILE^DIE("","WVFDA","WVERR")
  1. Q
  1. RESULTS(RESULT,WVIEN) ; Returns limited amount of information from the
  1. ; WV PROCEDURE file (790.1) for the IEN selected.
  1. ; Input: RESULT - Array name to return data in.
  1. ; WVIEN - FILE 790.1 IEN
  1. ;
  1. ; Output: RESULT(0)
  1. ; where: RESULT(0)=FILE 790.1 IEN^DFN^"Pap Smear" OR "Mammogram" OR
  1. ; "Breast Ultrasound"^Date/Time
  1. ;
  1. N WVDX,WVDATE,WVDFN,WVLIST,WVNODE,WVPROC,WVPTYPE,WVYES
  1. I +$G(WVIEN)'>0 S RESULT(0)="-1^^IEN not defined." G EXIT
  1. S WVNODE=$G(^WV(790.1,WVIEN,0))
  1. I WVNODE="" S RESULT(0)="-1^^No unprocessed procedure results in WH package." G EXIT
  1. S WVDFN=$P(WVNODE,U,2)
  1. S WVPTYPE=$E($P(WVNODE,U,1),1,2)
  1. S WVYES=$S(WVPTYPE="PS":1,WVPTYPE="MS":1,WVPTYPE="MB":1,WVPTYPE="MU":1,WVPTYPE="BU":1,1:0)
  1. I WVYES=0 S RESULT(0)="-1^"_WVDFN_"^Wrong procedure type." G EXIT
  1. S WVPTYPE=$S(WVPTYPE="PS":"P",WVPTYPE="BU":"U",1:"M")
  1. S WVDATE=$P(WVNODE,U,12)
  1. S RESULT(0)=WVIEN_U_WVDFN_U_$S(WVPTYPE="U":"Breast Ultrasound",WVPTYPE="P":"Pap Smear",1:"Mammogram")_U_WVDATE
  1. ; process mam or bu
  1. I WVPTYPE="M"!(WVPTYPE="U") D G EXIT
  1. .S (WVDX,WVLIST,WVPROC)=""
  1. .D RAD
  1. .; add rad procedure name^primary diagnosis^modifier 1~modifier n
  1. .S RESULT(0)=RESULT(0)_U_WVPROC_U_WVDX_U_WVLIST
  1. .Q
  1. ; pap smear
  1. N LRDFN,LRSS,WVCOLLDT,WVLABACC,WVLACCN,WVNODE2,WVSPEC
  1. S WVNODE=$G(^WV(790.1,+WVIEN,0))
  1. Q:WVNODE=""
  1. S WVNODE2=$G(^WV(790.1,+WVIEN,2))
  1. Q:WVNODE2=""
  1. S WVLABACC=$P(WVNODE2,U,17) ;lab accession number (e.g., CY 99 1)
  1. Q:WVLABACC=""
  1. S WVDATE=$P(WVNODE2,U,19) ;lab accession date (reverse date/time)
  1. Q:'WVDATE
  1. S LRDFN=$P(WVNODE2,U,18) ;lab patient ien
  1. Q:'LRDFN
  1. S LRSS=$P(WVNODE2,U,20) ;lab patient subscript
  1. Q:LRSS=""
  1. S (WVCOLLDT,WVLACCN,WVSPEC)=""
  1. D HS
  1. ; add collection date^lab accession#^specimen
  1. S RESULT(0)=RESULT(0)_"^^^^"_WVCOLLDT_U_WVLACCN_U_WVSPEC
  1. EXIT ;
  1. Q
  1. HS ; Health Summary variable setup
  1. N GMTS1,GMTS2,MAX
  1. S GMTS1=WVDATE-1,GMTS2=WVDATE+1,MAX=100
  1. I LRSS="CY" D CY ;cytology
  1. I LRSS="SP" D SP ;surgical pathology
  1. K ^TMP("LRA",$J),^TMP("LRCY",$J)
  1. Q
  1. CY ; Call Health Summary extract routine GMTSLRPE to get cytology data.
  1. ; Input: LRDFN - FILE 63 ien
  1. ; GMTS1 - reverse start date/time (most recent date)
  1. ; GMTS2 - reverse end date/time (least recent date)
  1. ; MAX - maximum # of occurrences to return
  1. ; Returns ^TMP("LRCY",$J)
  1. K ^TMP("LRCY",$J)
  1. I $T(XTRCT^GMTSLRPE)']"" Q ;HS routine doesn't exist
  1. D XTRCT^GMTSLRPE
  1. Q:'$D(^TMP("LRCY",$J))
  1. D WEEDCY
  1. Q:'$D(^TMP("LRCY",$J))
  1. D CYTO ;move data from HS array to WH array
  1. Q
  1. WEEDCY ; Weed out reports, save only report for lab accession number
  1. ; associated with this WH entry.
  1. N WVLOOP
  1. S WVLOOP=0
  1. F S WVLOOP=$O(^TMP("LRCY",$J,WVLOOP)) Q:'WVLOOP D
  1. .I $P($G(^TMP("LRCY",$J,WVLOOP,0)),U,2)'=WVLABACC D
  1. ..K ^TMP("LRCY",$J,WVLOOP)
  1. ..Q
  1. .Q
  1. Q
  1. CYTO ; Move data from ^TMP("LRCY",$J) to RESULT for display.
  1. Q:'$D(^TMP("LRCY",$J))
  1. N WVTMP
  1. S WVDATE=$O(^TMP("LRCY",$J,0)) Q:'WVDATE
  1. S WVTMP=$G(^TMP("LRCY",$J,WVDATE,0))
  1. S WVCOLLDT=$P(WVTMP,U,1) ;collection date
  1. S WVLACCN=$P(WVTMP,U,2) ;accession #
  1. S WVTMP=$G(^TMP("LRCY",$J,WVDATE,1,1))
  1. S WVSPEC=$P(WVTMP,U,1) ;specimen
  1. Q
  1. SP ; Call Health Summary extract routine GMTSLRAE to get surgical
  1. ; pathology data.
  1. ; Input: LRDFN - FILE 63 ien
  1. ; GMTS1 - reverse start date/time (most recent date)
  1. ; GMTS2 - reverse end date/time (least recent date)
  1. ; MAX - maximum # of occurrences to return
  1. ; Returns ^TMP("LRA",$J)
  1. K ^TMP("LRA",$J)
  1. I $T(XTRCT^GMTSLRAE)']"" Q ;HS routine doesn't exist
  1. D XTRCT^GMTSLRAE
  1. Q:'$D(^TMP("LRA",$J))
  1. D WEEDSP
  1. Q:'$D(^TMP("LRA",$J))
  1. D PATH ;move data from HS array to WH array
  1. Q
  1. WEEDSP ; Weed out reports, save only report for lab accession number
  1. ; associated with this WH entry.
  1. N WVLOOP
  1. S WVLOOP=0
  1. F S WVLOOP=$O(^TMP("LRA",$J,WVLOOP)) Q:'WVLOOP D
  1. .I $P($G(^TMP("LRA",$J,WVLOOP,0)),U,2)'=WVLABACC D
  1. ..K ^TMP("LRA",$J,WVLOOP)
  1. ..Q
  1. .Q
  1. Q
  1. PATH ; Move data from ^TMP("LRA",$J) to RESULT for display
  1. Q:'$D(^TMP("LRA",$J))
  1. N WVNODE,WVDATE,WVSUB2,WVSUB4,X,Y
  1. S WVDATE=0
  1. F S WVDATE=$O(^TMP("LRA",$J,WVDATE)) Q:'WVDATE D
  1. .S WVSUB2=""
  1. .S WVSUB2=$O(^TMP("LRA",$J,WVDATE,WVSUB2))
  1. .Q:WVSUB2=""!(WVSUB2?1A)
  1. .S WVNODE=$G(^TMP("LRA",$J,WVDATE,WVSUB2))
  1. .D ACCESSN
  1. .Q
  1. Q
  1. ACCESSN ; Collection date & Lab Accession#
  1. I WVSUB2=0 D
  1. .S WVCOLLDT=$P(WVNODE,U,1) ;collection date
  1. .S WVLACCN=$P(WVNODE,U,2) ;accession #
  1. .Q
  1. Q
  1. SPEC ; Specimen list
  1. S WVSUB4=$O(^TMP("LRA",$J,WVDATE,.1,0))
  1. S WVSPEC=$G(^TMP("LRA",$J,WVDATE,.1,WVSUB4))
  1. Q
  1. ;
  1. RAD ; get radiology report data
  1. N LOOP,WVDUP,WVERR,WVIENS,WVJCN,WVJCN1,WVLCNT,WVMOD,WVMODS
  1. N WVRADCSE,WVRADDFN,WVRADDTE,WVRADIEN,WVRPTIEN
  1. S WVRADIEN=$P(^WV(790.1,WVIEN,0),U,15)
  1. Q:WVRADIEN="" ;no 'radiology mam case #'
  1. S WVRADDFN=$P(^WV(790.1,WVIEN,0),U,2)
  1. Q:'WVRADDFN ;no dfn
  1. S WVRADDTE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,0))
  1. Q:'WVRADDTE ;no inverse exam date
  1. S WVRADCSE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,WVRADDTE,0))
  1. Q:'WVRADCSE ;no case number
  1. S WVRPTIEN=+$P(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0),U,17)
  1. Q:'WVRPTIEN ;no report in File 74
  1. K ^TMP($J,"WV RPT")
  1. S WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_"," ;iens for FILE 70 entry
  1. D GETS^DIQ(70.03,WVIENS,"125*","EI","WVMODS","WVERR")
  1. ; get data from FILE 74
  1. K WVERR
  1. D GETS^DIQ(74,WVRPTIEN_",","*","EI","^TMP($J,""WV RPT"")","WVERR")
  1. S WVPROC=^TMP($J,"WV RPT",74,WVRPTIEN_",",102,"E")
  1. S WVDX=^TMP($J,"WV RPT",74,WVRPTIEN_",",113,"E")
  1. ; get procedure modifiers
  1. S (LOOP,WVLIST)=""
  1. F S LOOP=$O(WVMODS(70.1,LOOP)) Q:LOOP="" D
  1. .S WVMOD=$G(WVMODS(70.1,LOOP,.01,"E"))
  1. .Q:WVMOD=""
  1. .S WVLIST=WVLIST_"~"_WVMOD
  1. .Q
  1. I $E(WVLIST)="~" S WVLIST=$E(WVLIST,2,$L(WVLIST))
  1. K ^TMP($J,"WV RPT")
  1. Q