142 lines
5.1 KiB
Mathematica
142 lines
5.1 KiB
Mathematica
WVRPCNO ;HIOFO/FT-WV NOTIFICATIONS file (790.4) RPCs ;1/7/05 15:03
|
|
;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
|
|
;
|
|
; This routine uses the following IAs:
|
|
; #10035 - FILE 2 (supported)
|
|
;
|
|
; This routine supports the following IAs:
|
|
; NEW - 4104
|
|
;
|
|
ACCESION(WVIEN) ; Returns the external value of FILE 790.4, Field .06
|
|
; Input: record ien
|
|
; Output: external value of the .01 field
|
|
Q $P($G(^WV(790.1,+WVIEN,0)),U,1)
|
|
;
|
|
OUTCOME(WVIEN) ; Returns the external value of FILE 790.405
|
|
; Input: record ien
|
|
; Output: external value of the .01 field
|
|
Q $P($G(^WV(790.405,+WVIEN,0)),U,1)
|
|
;
|
|
PURPOSE(WVIEN) ; Returns the external value of FILE 790.404
|
|
; Input: record ien
|
|
; Output: external value of the .01 field
|
|
Q $P($G(^WV(790.404,+WVIEN,0)),U,1)
|
|
;
|
|
TYPE(WVIEN) ; Returns the external value of FILE 790.403
|
|
; Input: record ien
|
|
; Output: external value of the .01 field
|
|
Q $P($G(^WV(790.403,+WVIEN,0)),U,1)
|
|
;
|
|
NEW(WVRESULT,WVNOTPUR) ; Update procedure result, create notification,
|
|
; print notification and update treatment needs.
|
|
; Input: WVRESULT(n)=FILE 790.1 IEN^"A", "N" or "U" (WVRESULT array is
|
|
; Optional)
|
|
; where A=Abnornal, N=No Evidence of Malignancy and
|
|
; U=Unsatisfactory for Dx.
|
|
; n is a number greater than zero.
|
|
;
|
|
; WVNOTPUR(FILE 790.404 IEN,n)=FILE 790.1 IEN^"I", "L" or "P"^
|
|
; FILE 3.5 NAME^DFN
|
|
; where I=In-person, L=letter and P=phone call (i.e.,
|
|
; notification type)
|
|
; Output: None
|
|
;
|
|
N WVCNT,WVDX,WVNODE,WVPURP,WVTYPE
|
|
I $O(WVRESULT(0)) D
|
|
.S WVCNT=0
|
|
.F S WVCNT=$O(WVRESULT(WVCNT)) Q:'WVCNT D
|
|
..S WVDX=$$GETDXIEN^WVRPCNO1($P(WVRESULT(WVCNT),U,2))
|
|
..D SETRESLT^WVRPCPR($P(WVRESULT(WVCNT),U,1),WVDX)
|
|
..Q
|
|
.Q
|
|
Q:'$O(WVNOTPUR(0))
|
|
S WVPURP=0
|
|
F S WVPURP=$O(WVNOTPUR(WVPURP)) Q:'WVPURP D
|
|
.S WVCNT=0
|
|
.F S WVCNT=$O(WVNOTPUR(WVPURP,WVCNT)) Q:'WVCNT D
|
|
..S WVNODE=$G(WVNOTPUR(WVPURP,WVCNT))
|
|
..Q:WVNODE=""
|
|
..;resolve type code to an IEN
|
|
..S WVTYPE=$P(WVNODE,U,2)
|
|
..I $P(WVNODE,U,2)'="CPRS" S WVTYPE=$$GETYPIEN^WVRPCNO1($P(WVNODE,U,2))
|
|
..;throw away printer value if not a letter
|
|
..I $P(WVNODE,U,2)'="L" S $P(WVNODE,U,3)=""
|
|
..D ADD($P(WVNODE,U,1),WVPURP,WVTYPE,$P(WVNODE,U,3),$P(WVNODE,U,4))
|
|
..Q
|
|
.Q
|
|
Q
|
|
ADD(WVIEN,WVPURP,WVTYPE,WVPRINTR,WVDFN) ; Create a new notification entry
|
|
; in FILE 790.4.
|
|
; Input: WVIEN - FILE 790.1 IEN [Required]
|
|
; WVPURP - FILE 790.404 IEN [Required]
|
|
; WVTYPE - FILE 790.403 IEN [Required]
|
|
; WVPRINTR - FILE 3.5 NAME (device) [Optional]
|
|
; WVDFN - FILE 790 IEN [Optional]
|
|
; Output: <None>
|
|
;
|
|
N BRDD,BRTX,CRDD,CRTX,DA,DFN,DLAYGO
|
|
N WVDA7904,WVDXFLAG,WVERR,WVERRADD,WVFAC,WVFDA,WVFDAIEN
|
|
N WVLDAT,WVLPRG,WVNODE,WVNPFLAG,WVOUTCUM,WVPDATE,WVTXFLAG
|
|
I $G(WVIEN)>0 D
|
|
.S WVNODE=$G(^WV(790.1,+$G(WVIEN),0))
|
|
.Q:WVNODE=""
|
|
.S WVDFN=$P(WVNODE,U,2)
|
|
.S WVFAC=+$P(WVNODE,U,10)
|
|
.S WVPDATE=$P(WVNODE,U,12) ;procedure date
|
|
.Q
|
|
Q:'$G(WVDFN)
|
|
S WVNPFLAG=0 ;new patient flag
|
|
I '$D(^WV(790,+$G(WVDFN),0)) D Q:'WVNPFLAG ;patient not in WH package
|
|
.Q:$P($G(^DPT(WVDFN,0)),U,2)'="F" ;not female
|
|
.Q:'$D(^WV(790.02,DUZ(2))) ;no site parameters
|
|
.Q:'$P($G(^WV(790.02,+$G(DUZ(2)),0)),U,2) ;no default case mgr
|
|
.S DFN=WVDFN
|
|
.Q:'$$VNVEC^WVRALIN1() ;vet/non-vet/eligibility code check
|
|
.S WVERRADD=1
|
|
.D AUTOADD^WVPATE(WVDFN,DUZ(2),.WVERRADD) ;add patient to FILE 790
|
|
.I WVERRADD>0 S WVNPFLAG=1 ;patient added
|
|
.Q
|
|
I '$D(^WV(790.404,+$G(WVPURP),0)) Q ;purpose
|
|
I '$G(WVFAC) S WVFAC=DUZ(2) ;facility ien
|
|
S WVDXFLAG=$P($G(^WV(790.02,+WVFAC,0)),U,11,12)
|
|
S WVTXFLAG=$P(WVDXFLAG,U,2) ;update treatment needs?
|
|
S WVDXFLAG=$P(WVDXFLAG,U,1) ;update results/dx?
|
|
S:$G(WVPDATE)'>0 WVPDATE=DT ;use today if no procedure date
|
|
I $G(WVTYPE)="CPRS" G TX
|
|
I '$D(^WV(790.403,+$G(WVTYPE),0)) Q ;type
|
|
S WVOUTCUM=""
|
|
I $G(WVPRINTR)]"" S WVOUTCUM=$$GETOIEN^WVRPCNO1("Letter Sent")
|
|
; create File 790.4 entry
|
|
S WVFDA(790.4,"+1,",.01)=WVDFN ;DFN
|
|
S WVFDA(790.4,"+1,",.02)=DT ;date opened
|
|
S WVFDA(790.4,"+1,",.03)=WVTYPE ;type
|
|
S WVFDA(790.4,"+1,",.04)=WVPURP ;purpose
|
|
S WVFDA(790.4,"+1,",.05)=WVOUTCUM ;outcome
|
|
S WVFDA(790.4,"+1,",.06)=$G(WVIEN) ;wh accession #
|
|
S WVFDA(790.4,"+1,",.07)=$S($G(WVFAC):$G(WVFAC),1:DUZ(2)) ;facility
|
|
S WVFDA(790.4,"+1,",.08)=DT ;date closed
|
|
I $P($G(^WV(790.403,+$G(WVTYPE),0)),U,2)=1 D
|
|
.S WVFDA(790.4,"+1,",.11)=DT ;print date
|
|
.Q
|
|
S WVFDA(790.4,"+1,",.13)=DT ;complete by date
|
|
S WVFDA(790.4,"+1,",.14)="c" ;status
|
|
D UPDATE^DIE("","WVFDA","WVFDAIEN","WVERR")
|
|
S WVDA7904=WVFDAIEN(1)
|
|
;
|
|
TX ; update treatment needs
|
|
I WVTXFLAG=1 D
|
|
.S WVNODE=$G(^WV(790.404,WVPURP,0))
|
|
.S BRTX=$S($P(WVNODE,U,7)]"":$P(WVNODE,U,7),1:"") ;breast tx need
|
|
.S BRDD=$S($P(WVNODE,U,8)]"":$P(WVNODE,U,8),1:"") ;breast tx due date
|
|
.S CRTX=$S($P(WVNODE,U,9)]"":$P(WVNODE,U,9),1:"") ;cervical tx need
|
|
.S CRDD=$S($P(WVNODE,U,10)]"":$P(WVNODE,U,10),1:"") ;cervical tx due date
|
|
.D BRTX^WVRPCPT(WVDFN,BRTX,BRDD,CRTX,CRDD,WVPDATE) ;update tx needs & due dates
|
|
.Q
|
|
; print notification?
|
|
Q:$G(WVPRINTR)="" ;no printer defined
|
|
Q:$P($G(^WV(790.403,+$G(WVTYPE),0)),U,2)'=1 ;not printable
|
|
S WVPRINTR=$P(WVPRINTR,";",2)
|
|
Q:WVPRINTR=""
|
|
D DEVICE^WVRPCNO1(WVDA7904,WVPRINTR) ;print letter
|
|
Q
|