source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVRPCPR.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1WVRPCPR ;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 ;
10TYPEIEN(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 ;
20TYPENAME(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 ;
29BUIEN() ; This function returns the IEN for a BREAST ULTRASOUND procedure
30 ; type from FILE 790.2
31 Q $$TYPEIEN("BREAST ULTRASOUND")
32 ;
33PAPIEN() ; This function returns the IEN for a screening PAP SMEAR
34 ; procedure type from FILE 790.2
35 Q $$TYPEIEN("PAP SMEAR")
36 ;
37MAMIENS() ; 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 ;
51LATEST(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
138SETRESLT(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
Note: See TracBrowser for help on using the repository browser.