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

WVRPCPR.m

Go to the documentation of this file. 
  1. WVRPCPR ;HIOFO/FT-WV PROCEDURE file (790.1) RPCs (cont.) ;07/06/2020
  1.  ;;1.0;WOMEN'S HEALTH;**16,26**;Sep 30, 1998;Build 624
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ; #10103 - ^XLFDT calls           (supported)
  1.  ;
  1.  ; This routine supports the following IAs:
  1.  ; LATEST - 4105
  1.  ;
  1. TYPEIEN(WVNAME) ; This function returns the IEN of an entry in the
  1.  ; WV PROCEDURE TYPE file (#790.2)
  1.  ;  Input: WVNAME is the procedure name (i.e., .01 value)
  1.  ; Output: IEN of the procedure type. Returns -1 if not found.
  1.  N WVIEN
  1.  I WVNAME="" Q -1  ;can't be null
  1.  S WVIEN=$O(^WV(790.2,"B",WVNAME,0))
  1.  S:WVIEN'>0 WVIEN=-1
  1.  Q WVIEN
  1.  ;
  1. TYPENAME(WVIEN) ; This function returns the NAME of an entry in the
  1.  ; WV PROCEDURE TYPE file (#790.2)
  1.  ;  Input: IEN (FILE 790.2)
  1.  ; Output: Name of the procedure type. Returns -1 if not found.
  1.  N WVNAME
  1.  I WVIEN="" Q -1  ;can't be null
  1.  S WVNAME=$P($G(^WV(790.2,+WVIEN,0)),U,1)
  1.  Q WVNAME
  1.  ;
  1. BUIEN() ; This function returns the IEN for a BREAST ULTRASOUND procedure
  1.  ; type from FILE 790.2
  1.  Q $$TYPEIEN("BREAST ULTRASOUND")
  1.  ;
  1. PAPIEN() ; This function returns the IEN for a screening PAP SMEAR
  1.  ; procedure type from FILE 790.2
  1.  Q $$TYPEIEN("PAP SMEAR")
  1.  ;
  1. MAMIENS() ; This function returns the IENs for diagnostic MAMMOGRAM
  1.  ; procedure types from FILE 790.2
  1.  ; returns a string delimited by caret with the IENS (e.g., "25^26"
  1.  N WVARRAY,WVCNT,WVDIAG,WVIEN,WVNAME
  1.  S (WVDIAG,WVNAME)="",WVCNT=0
  1.  S WVARRAY("MAMMOGRAM DX UNILAT")=""
  1.  S WVARRAY("MAMMOGRAM DX BILAT")=""
  1.  S WVARRAY("MAMMOGRAM SCREENING")=""
  1.  F  S WVNAME=$O(WVARRAY(WVNAME)) Q:WVNAME=""  D
  1.  .S WVIEN=$$TYPEIEN(WVNAME)
  1.  .I WVIEN>0 S WVCNT=WVCNT+1,$P(WVDIAG,U,WVCNT)=WVIEN
  1.  .Q
  1.  Q WVDIAG
  1.  ;
  1. LATEST(RESULT,WVDFN,WVPTYPE,WVDATES,WVMAX,WVDX) ; Returns the Pap Smear or
  1.  ; Mammogram entries in reverse chronological order.
  1.  ; Input:   RESULT - Array name for return values [required]
  1.  ;           WVDFN - patient DFN [required]
  1.  ;         WVPTYPE - "P" for Pap Smear or "M" for Mammogram or
  1.  ;                   "U" for Breast Ultrasound [required]
  1.  ;         WVDATES - date range in FileMan internal format
  1.  ;                   (e.g., 3020101^3021231) [optional]
  1.  ;           WVMAX - max number of entries to return (e.g., 20)
  1.  ;                   (optional - default is 10) [optional]
  1.  ;            WVDX - "N", "A", "P" or "*" to return records with a
  1.  ;                   dx/result of normal, abnormal, pending or any
  1.  ;                   [optional]
  1.  ;
  1.  ; Output: RESULT(0)=# of matches^
  1.  ;                   or=-1^error message
  1.  ;         RESULT(n)=IEN^DFN^DATE^TYPE^DX CATEGORY^DX Result^Rad/Lab
  1.  ;                   Link^FILE 790.1 STATUS
  1.  ;   where IEN = FILE 790.1 internal entry number
  1.  ;         DFN = FILE 2 internal entry number
  1.  ;        DATE = Procedure date in FileMan format
  1.  ;        TYPE = Procedure name (from FILE 790.2)
  1.  ; DX Category = Normal, Abnormal or Pending
  1.  ;   DX Result = FILE 790.31, Field .01
  1.  ;RAD/LAB LINK = 0=no link to rad/lab entry, 1=link to rad/lab entry
  1.  ;      Status = File 790.1 procedure status ('OPEN' or 'CLOSED')
  1.  ;
  1.  I '$G(WVDFN) D  Q
  1.  .S RESULT(0)="-1^Patient DFN is not numeric or undefined."
  1.  .Q 
  1.  I $G(WVPTYPE)="" D  Q
  1.  .S RESULT(0)="-1^Procedure type not identified."
  1.  .Q
  1.  I '$D(^WV(790.1,"C",WVDFN)) D  Q
  1.  .S RESULT(0)="-1^No procedures found for this patient"
  1.  .Q
  1.  N WVCOUNT,WVEND,WVIEN,WVLOOP,WVMANUAL,WVNODE,WVNODE1,WVNORM,WVOUT,WVRD
  1.  N WVRESULT,WVSTART,WVSTATUS,WVTYPE,WVYES
  1.  S (WVCOUNT,WVLOOP,WVOUT)=0
  1.  S:'$D(WVDATES) WVDATES="^"
  1.  S WVSTART=$P(WVDATES,U,1) ;search start date
  1.  S:WVSTART="" WVSTART=$$FMADD^XLFDT(DT,-1095)
  1.  S WVEND=$P(WVDATES,U,2) ;search end date
  1.  S:WVEND="" WVEND=DT
  1.  S:+$G(WVMAX)'>0 WVMAX=10
  1.  S:$G(WVDX)="" WVDX="*"
  1.  S WVLOOP=WVEND+.000001
  1.  F  S WVLOOP=$O(^WV(790.1,"AC",WVDFN,WVLOOP),-1) Q:'WVLOOP!(WVSTART>WVLOOP)!(WVOUT=1)  D
  1.  .S WVIEN=0
  1.  .F  S WVIEN=$O(^WV(790.1,"AC",WVDFN,WVLOOP,WVIEN)) Q:'WVIEN!(WVOUT=1)  D
  1.  ..S WVNODE=$G(^WV(790.1,+WVIEN,0))
  1.  ..Q:WVNODE=""
  1.  ..I $P(WVNODE,U,5)=$$ERROR^WVRPCPR1() Q  ;error/disregard diagnosis 
  1.  ..;check procedure types
  1.  ..S WVYES=0
  1.  ..I WVPTYPE="P",$E($P(WVNODE,U,1),1,2)="PS" S WVYES=1
  1.  ..I WVPTYPE="M",$E($P(WVNODE,U,1),1,2)="MB" S WVYES=1
  1.  ..I WVPTYPE="M",$E($P(WVNODE,U,1),1,2)="MU" S WVYES=1
  1.  ..I WVPTYPE="M",$E($P(WVNODE,U,1),1,2)="MS" S WVYES=1
  1.  ..I WVPTYPE="U",$E($P(WVNODE,U,1),1,2)="BU" S WVYES=1
  1.  ..Q:'WVYES
  1.  ..;check result/dx value
  1.  ..S WVYES=0
  1.  ..S WVNORM=$$NORMAL^WVRPCPR1($P(WVNODE,U,5)) ;is dx normal/abnormal?
  1.  ..I WVDX="N",WVNORM=0 S WVYES=1
  1.  ..I WVDX="A",WVNORM=1 S WVYES=1
  1.  ..I WVDX="P",WVNORM=2 S WVYES=1
  1.  ..I WVDX="P",$P(WVNODE,U,5)="" S WVYES=1 ;treat 'NO RESULT' & null alike
  1.  ..I WVDX="*" S WVYES=1
  1.  ..Q:'WVYES
  1.  ..I WVCOUNT=WVMAX S WVOUT=1 Q  ;max # reached, stop looking
  1.  ..S WVCOUNT=WVCOUNT+1
  1.  ..S WVSTATUS=$P(WVNODE,U,14)
  1.  ..S WVSTATUS=$S(WVSTATUS="o":"OPEN",WVSTATUS="c":"CLOSED",WVSTATUS="e":"ENTER IN ERROR",1:"OPEN")
  1.  ..S WVTYPE=$$TYPENAME(+$P(WVNODE,U,4))
  1.  ..S WVRESULT=$$DXNAME^WVRPCPR1($P(WVNODE,U,5))
  1.  ..S WVNORM=$S(WVNORM=0:"Normal",WVNORM=1:"Abnormal",WVNORM=2:"Unsatisfactory",1:"Pending")
  1.  ..S WVMANUAL=0 ;0=no link to rad/lab entry, 1=link to rad/lab entry
  1.  ..I $P($G(^WV(790.1,WVIEN,2)),U,17)]""!($P(WVNODE,U,15)]"") S WVMANUAL=1
  1.  ..;WVNODE1=IEN^DFN^DATE^TYPE^Dx Category^DX Result^Manual
  1.  ..S WVNODE1=WVIEN_U_$P(WVNODE,U,2)_U_$P(WVNODE,U,12)_U_WVTYPE_U_WVNORM_U_WVRESULT_U_WVMANUAL_U_WVSTATUS
  1.  ..S RESULT(WVCOUNT)=WVNODE1
  1.  ..Q
  1.  .Q
  1.  I WVCOUNT=0 S RESULT(0)="-1^No records matched."
  1.  I WVCOUNT>0 S RESULT(0)=WVCOUNT_U
  1.  Q
  1. SETRESLT(WVIEN,WVRESULT) ; Update the RESULTS/DIAGNOSIS field (.05)
  1.  ; for the WV PROCEDURE file (#790.1) record identified by WVIEN. 
  1.  ; Input:    WVIEN - FILE 790.1 IEN
  1.  ;        WVRESULT - FILE 790.31 IEN
  1.  ;
  1.  ; Output: <none>
  1.  ;
  1.  N WVERR,WVDXFLAG,WVFAC,WVFDA
  1.  I $G(WVIEN)'>0 Q
  1.  D UPDATE^WVALERTS(WVIEN) ;mark procedure as processed by CR
  1.  I $G(WVRESULT)'>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_",",.05)=WVRESULT
  1.  S WVFDA(790.1,WVIEN_",",.14)="c"
  1.  D FILE^DIE("","WVFDA","WVERR")
  1.  Q