1 | WVRPCPR ;HIOFO/FT-WV PROCEDURE file (790.1) RPCs (cont.) ;9/29/03 15:15
|
---|
2 | ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
|
---|
3 | ;
|
---|
4 | ; This routine uses the following IAs:
|
---|
5 | ; #10103 - ^XLFDT calls (supported)
|
---|
6 | ;
|
---|
7 | ; This routine supports the following IAs:
|
---|
8 | ; LATEST - 4105
|
---|
9 | ;
|
---|
10 | TYPEIEN(WVNAME) ; This function returns the IEN of an entry in the
|
---|
11 | ; WV PROCEDURE TYPE file (#790.2)
|
---|
12 | ; Input: WVNAME is the procedure name (i.e., .01 value)
|
---|
13 | ; Output: IEN of the procedure type. Returns -1 if not found.
|
---|
14 | N WVIEN
|
---|
15 | I WVNAME="" Q -1 ;can't be null
|
---|
16 | S WVIEN=$O(^WV(790.2,"B",WVNAME,0))
|
---|
17 | S:WVIEN'>0 WVIEN=-1
|
---|
18 | Q WVIEN
|
---|
19 | ;
|
---|
20 | TYPENAME(WVIEN) ; This function returns the NAME of an entry in the
|
---|
21 | ; WV PROCEDURE TYPE file (#790.2)
|
---|
22 | ; Input: IEN (FILE 790.2)
|
---|
23 | ; Output: Name of the procedure type. Returns -1 if not found.
|
---|
24 | N WVNAME
|
---|
25 | I WVIEN="" Q -1 ;can't be null
|
---|
26 | S WVNAME=$P($G(^WV(790.2,+WVIEN,0)),U,1)
|
---|
27 | Q WVNAME
|
---|
28 | ;
|
---|
29 | BUIEN() ; This function returns the IEN for a BREAST ULTRASOUND procedure
|
---|
30 | ; type from FILE 790.2
|
---|
31 | Q $$TYPEIEN("BREAST ULTRASOUND")
|
---|
32 | ;
|
---|
33 | PAPIEN() ; This function returns the IEN for a screening PAP SMEAR
|
---|
34 | ; procedure type from FILE 790.2
|
---|
35 | Q $$TYPEIEN("PAP SMEAR")
|
---|
36 | ;
|
---|
37 | MAMIENS() ; This function returns the IENs for diagnostic MAMMOGRAM
|
---|
38 | ; procedure types from FILE 790.2
|
---|
39 | ; returns a string delimited by caret with the IENS (e.g., "25^26"
|
---|
40 | N WVARRAY,WVCNT,WVDIAG,WVIEN,WVNAME
|
---|
41 | S (WVDIAG,WVNAME)="",WVCNT=0
|
---|
42 | S WVARRAY("MAMMOGRAM DX UNILAT")=""
|
---|
43 | S WVARRAY("MAMMOGRAM DX BILAT")=""
|
---|
44 | S WVARRAY("MAMMOGRAM SCREENING")=""
|
---|
45 | F S WVNAME=$O(WVARRAY(WVNAME)) Q:WVNAME="" D
|
---|
46 | .S WVIEN=$$TYPEIEN(WVNAME)
|
---|
47 | .I WVIEN>0 S WVCNT=WVCNT+1,$P(WVDIAG,U,WVCNT)=WVIEN
|
---|
48 | .Q
|
---|
49 | Q WVDIAG
|
---|
50 | ;
|
---|
51 | LATEST(RESULT,WVDFN,WVPTYPE,WVDATES,WVMAX,WVDX) ; Returns the Pap Smear or
|
---|
52 | ; Mammogram entries in reverse chronological order.
|
---|
53 | ; Input: RESULT - Array name for return values [required]
|
---|
54 | ; WVDFN - patient DFN [required]
|
---|
55 | ; WVPTYPE - "P" for Pap Smear or "M" for Mammogram or
|
---|
56 | ; "U" for Breast Ultrasound [required]
|
---|
57 | ; WVDATES - date range in FileMan internal format
|
---|
58 | ; (e.g., 3020101^3021231) [optional]
|
---|
59 | ; WVMAX - max number of entries to return (e.g., 20)
|
---|
60 | ; (optional - default is 10) [optional]
|
---|
61 | ; WVDX - "N", "A", "P" or "*" to return records with a
|
---|
62 | ; dx/result of normal, abnormal, pending or any
|
---|
63 | ; [optional]
|
---|
64 | ;
|
---|
65 | ; Output: RESULT(0)=# of matches^
|
---|
66 | ; or=-1^error message
|
---|
67 | ; RESULT(n)=IEN^DFN^DATE^TYPE^DX CATEGORY^DX Result^Rad/Lab
|
---|
68 | ; Link^FILE 790.1 STATUS
|
---|
69 | ; where IEN = FILE 790.1 internal entry number
|
---|
70 | ; DFN = FILE 2 internal entry number
|
---|
71 | ; DATE = Procedure date in FileMan format
|
---|
72 | ; TYPE = Procedure name (from FILE 790.2)
|
---|
73 | ; DX Category = Normal, Abnormal or Pending
|
---|
74 | ; DX Result = FILE 790.31, Field .01
|
---|
75 | ;RAD/LAB LINK = 0=no link to rad/lab entry, 1=link to rad/lab entry
|
---|
76 | ; Status = File 790.1 procedure status ('OPEN' or 'CLOSED')
|
---|
77 | ;
|
---|
78 | I '$G(WVDFN) D Q
|
---|
79 | .S RESULT(0)="-1^Patient DFN is not numeric or undefined."
|
---|
80 | .Q
|
---|
81 | I $G(WVPTYPE)="" D Q
|
---|
82 | .S RESULT(0)="-1^Procedure type not identified."
|
---|
83 | .Q
|
---|
84 | I '$D(^WV(790.1,"C",WVDFN)) D Q
|
---|
85 | .S RESULT(0)="-1^No procedures found for this patient"
|
---|
86 | .Q
|
---|
87 | N WVCOUNT,WVEND,WVIEN,WVLOOP,WVMANUAL,WVNODE,WVNODE1,WVNORM,WVOUT,WVRD
|
---|
88 | N WVRESULT,WVSTART,WVSTATUS,WVTYPE,WVYES
|
---|
89 | S (WVCOUNT,WVLOOP,WVOUT)=0
|
---|
90 | S:'$D(WVDATES) WVDATES="^"
|
---|
91 | S WVSTART=$P(WVDATES,U,1) ;search start date
|
---|
92 | S:WVSTART="" WVSTART=$$FMADD^XLFDT(DT,-1095)
|
---|
93 | S WVEND=$P(WVDATES,U,2) ;search end date
|
---|
94 | S:WVEND="" WVEND=DT
|
---|
95 | S:+$G(WVMAX)'>0 WVMAX=10
|
---|
96 | S:$G(WVDX)="" WVDX="*"
|
---|
97 | S WVLOOP=WVEND+.000001
|
---|
98 | F S WVLOOP=$O(^WV(790.1,"AC",WVDFN,WVLOOP),-1) Q:'WVLOOP!(WVSTART>WVLOOP)!(WVOUT=1) D
|
---|
99 | .S WVIEN=0
|
---|
100 | .F S WVIEN=$O(^WV(790.1,"AC",WVDFN,WVLOOP,WVIEN)) Q:'WVIEN!(WVOUT=1) D
|
---|
101 | ..S WVNODE=$G(^WV(790.1,+WVIEN,0))
|
---|
102 | ..Q:WVNODE=""
|
---|
103 | ..I $P(WVNODE,U,5)=$$ERROR^WVRPCPR1() Q ;error/disregard diagnosis
|
---|
104 | ..;check procedure types
|
---|
105 | ..S WVYES=0
|
---|
106 | ..I WVPTYPE="P",$E($P(WVNODE,U,1),1,2)="PS" S WVYES=1
|
---|
107 | ..I WVPTYPE="M",$E($P(WVNODE,U,1),1,2)="MB" S WVYES=1
|
---|
108 | ..I WVPTYPE="M",$E($P(WVNODE,U,1),1,2)="MU" S WVYES=1
|
---|
109 | ..I WVPTYPE="M",$E($P(WVNODE,U,1),1,2)="MS" S WVYES=1
|
---|
110 | ..I WVPTYPE="U",$E($P(WVNODE,U,1),1,2)="BU" S WVYES=1
|
---|
111 | ..Q:'WVYES
|
---|
112 | ..;check result/dx value
|
---|
113 | ..S WVYES=0
|
---|
114 | ..S WVNORM=$$NORMAL^WVRPCPR1($P(WVNODE,U,5)) ;is dx normal/abnormal?
|
---|
115 | ..I WVDX="N",WVNORM=0 S WVYES=1
|
---|
116 | ..I WVDX="A",WVNORM=1 S WVYES=1
|
---|
117 | ..I WVDX="P",WVNORM=2 S WVYES=1
|
---|
118 | ..I WVDX="P",$P(WVNODE,U,5)="" S WVYES=1 ;treat 'NO RESULT' & null alike
|
---|
119 | ..I WVDX="*" S WVYES=1
|
---|
120 | ..Q:'WVYES
|
---|
121 | ..I WVCOUNT=WVMAX S WVOUT=1 Q ;max # reached, stop looking
|
---|
122 | ..S WVCOUNT=WVCOUNT+1
|
---|
123 | ..S WVSTATUS=$P(WVNODE,U,14)
|
---|
124 | ..S WVSTATUS=$S(WVSTATUS="o":"OPEN",WVSTATUS="c":"CLOSED",1:"OPEN")
|
---|
125 | ..S WVTYPE=$$TYPENAME(+$P(WVNODE,U,4))
|
---|
126 | ..S WVRESULT=$$DXNAME^WVRPCPR1($P(WVNODE,U,5))
|
---|
127 | ..S WVNORM=$S(WVNORM=0:"Normal",WVNORM=1:"Abnormal",WVNORM=2:"Unsatisfactory",1:"Pending")
|
---|
128 | ..S WVMANUAL=0 ;0=no link to rad/lab entry, 1=link to rad/lab entry
|
---|
129 | ..I $P($G(^WV(790.1,WVIEN,2)),U,17)]""!($P(WVNODE,U,15)]"") S WVMANUAL=1
|
---|
130 | ..;WVNODE1=IEN^DFN^DATE^TYPE^Dx Category^DX Result^Manual
|
---|
131 | ..S WVNODE1=WVIEN_U_$P(WVNODE,U,2)_U_$P(WVNODE,U,12)_U_WVTYPE_U_WVNORM_U_WVRESULT_U_WVMANUAL_U_WVSTATUS
|
---|
132 | ..S RESULT(WVCOUNT)=WVNODE1
|
---|
133 | ..Q
|
---|
134 | .Q
|
---|
135 | I WVCOUNT=0 S RESULT(0)="-1^No records matched."
|
---|
136 | I WVCOUNT>0 S RESULT(0)=WVCOUNT_U
|
---|
137 | Q
|
---|
138 | SETRESLT(WVIEN,WVRESULT) ; Update the RESULTS/DIAGNOSIS field (.05)
|
---|
139 | ; for the WV PROCEDURE file (#790.1) record identified by WVIEN.
|
---|
140 | ; Input: WVIEN - FILE 790.1 IEN
|
---|
141 | ; WVRESULT - FILE 790.31 IEN
|
---|
142 | ;
|
---|
143 | ; Output: <none>
|
---|
144 | ;
|
---|
145 | N WVERR,WVDXFLAG,WVFAC,WVFDA
|
---|
146 | I $G(WVIEN)'>0 Q
|
---|
147 | D UPDATE^WVALERTS(WVIEN) ;mark procedure as processed by CR
|
---|
148 | I $G(WVRESULT)'>0 Q
|
---|
149 | ; Check 'update results/dx?' parameter
|
---|
150 | S WVFAC=+$P($G(^WV(790.1,+WVIEN,0)),U,10)
|
---|
151 | S WVDXFLAG=$P($G(^WV(790.02,+WVFAC,0)),U,11)
|
---|
152 | Q:'WVDXFLAG
|
---|
153 | S WVFDA(790.1,WVIEN_",",.05)=WVRESULT
|
---|
154 | S WVFDA(790.1,WVIEN_",",.14)="c"
|
---|
155 | D FILE^DIE("","WVFDA","WVERR")
|
---|
156 | Q
|
---|