source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVEXPTRA.m@ 789

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1WVEXPTRA ;HCIOFO/FT-EXPORT MAMS & ULTRASOUNDS TO WOMEN'S HEALTH ;2/18/00 13:49
2 ;;1.0;WOMEN'S HEALTH;**3,5,7,10**;Sep 30, 1998
3 ;; Original routine created by IHS/ANMC/MWR
4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
5 ;---> WVNEWP = TOTAL NEW WOMEN'S HEALTH PATIENTS ADDED.
6 ;---> WVMAM = TOTAL NEW MAMMOGRAMS PROCEDURES ADDED.
7 ;
8EN1 ;
9 S WVPOP=0,WVEC=""
10 D CHECK I WVPOP D KILL Q ;check if site parameter entry exists
11 D DESC ;describe option
12 D DTRNG I WVPOP D KILL Q ;get date range
13 D STATUS I WVPOP D KILL Q ;select status of procedure
14 D EC^WVGETAL1 I WVPOP D KILL Q ;veterans/non-vets/eligibility code
15 D QUEUE ;queue a background job
16 D KILL
17 Q
18EN2 ;
19 D CPTS ;get procedure pointers
20 D GET ;get RAD/NM data & store in WH
21 D MAIL ;send mail message to user
22 D KILL ;kill variables
23 Q
24DESC ; Describe option
25 W @IOF
26 W !,"This option searches the Radiology/Nuclear Medicine database for"
27 W !,"all female patients who had a mammogram, breast ultrasound, pelvic"
28 W !,"ultrasound or vaginal ultrasound exam during the date range you select."
29 W !,"These procedures and patients will be added to the WH database if"
30 W !,"not already there.",!
31 W !,"This job will be queued as a background task so as to free up your"
32 W !,"terminal to do other work. You will receive a mail message when"
33 W !,"the job is done. The mail message will contain a count of the"
34 W !,"number of procedures and patients added.",!!
35 Q
36CHECK ; Check if DUZ(2) exists for user, if entry exists in site parameter
37 ; file, if case manager, and if File 70 exists.
38 D CHECK^WVLOGO
39 I '$G(DUZ(2))!('$D(^WV(790.02,+DUZ(2),0))) S WVPOP=1
40 I '$P($G(^WV(790.02,+$G(DUZ(2)),0)),U,2) D
41 .D NODCM^WVUTL9
42 .S WVPOP=1
43 .Q
44 I '$D(^RADPT) W !,"There is no Radiology/Nuclear Medicine Patient file (#70)",! S WVPOP=1
45 Q
46DTRNG ; prompt for date range, go back three years maximum
47 S WVSTDT=DT-30000,WVSTDT=$$DATECHK(WVSTDT)
48 K DIR S DIR(0)="DA^"_WVSTDT_":"_DT
49 S DIR("A")="Enter START DATE: "
50 S DIR("?")="Enter the earliest date of the mammograms/ultrasounds you wish to retrieve. You can begin your search at "_$$FMTE^XLFDT(WVSTDT,"D")_"."
51 D ^DIR K DIR
52 I $D(DIRUT) S WVPOP=1 Q
53 S WVSTDT=Y
54 S DIR(0)="DA^"_WVSTDT_":"_DT
55 S DIR("A")="Enter END DATE: ",DIR("B")=$$FMTE^XLFDT(DT,"D")
56 S DIR("?")="Enter the most recent date of the mammograms/ultrasounds you wish to retrieve."
57 D ^DIR K DIR
58 I $D(DIRUT) S WVPOP=1 Q
59 S WVENDT=Y
60 Q
61DATECHK(WVDATE) ; Check if WVDATE is a valid date. Substract 1 day until a
62 ; valid date in WVDATE and return same.
63 N %DT,WVLOOP,X,Y
64 S Y=0
65 F WVLOOP=1:1 Q:Y>0 D
66 .S X=WVDATE,%DT=""
67 .D ^%DT
68 .Q:Y>0 ;valid date - stop checking
69 .S WVDATE=$$FMADD^XLFDT(WVDATE,-1)
70 .Q
71 Q WVDATE
72 ;
73STATUS ; Select default status for procedures
74 K DIR
75 S DIR(0)="S^o:OPEN;c:CLOSED",DIR("A")="Select STATUS OF IMPORTED MAMMOGRAMS"
76 S DIR("?")="Enter 'O' to give a Status of OPEN to Mammograms imported from the Radiology Software into the Women's Health database. Enter 'C' to give a Status of CLOSED to imported Mammograms."
77 D ^DIR K DIR
78 I $D(DIRUT) S WVPOP=1
79 S WVSTATUS=Y
80 Q
81QUEUE ; Task as background job
82 S ZTIO="",ZTDESC="WH GRAB RAD/NM DATA",ZTRTN="EN2^WVEXPTRA"
83 S ZTDTH=$H,WVPOP=1
84 S ZTSAVE("WVENDT")="",ZTSAVE("WVSTDT")="",ZTSAVE("WVSTATUS")=""
85 S ZTSAVE("WVEC(")=""
86 D ^%ZTLOAD
87 Q
88CPTS ; Loop through File 71 to get procedure pointers for the CPTs we
89 ; are interested in.
90 N WVPROC S WVIEN=0 K WVARRAY
91 F S WVIEN=$O(^RAMIS(71,WVIEN)) Q:'WVIEN D
92 .S WVCPT=$$GET1^DIQ(71,WVIEN,9,"I") ;CPT code
93 .Q:WVCPT=""
94 .S WVPROC=0
95 .S WVPROC=$O(^WV(790.2,"AC",WVCPT,WVPROC))
96 .Q:'WVPROC
97 .Q:$P($G(^WV(790.2,+WVPROC,0)),U,5)'="R"
98 .S WVARRAY(WVIEN)=""
99 .Q
100 Q
101GET ; get mammograms and ultrasounds from RAD/NM database
102 ;---> WVMCNT = total new procedures added.
103 ;---> WVNEWP = total new patients added.
104 S (WVMCNT,WVNEWP)=0
105 Q:'$D(WVARRAY) ;no mammogram or ultrasound procedures in File 71
106 S WVENDT=WVENDT\1,WVENDT=9999999-WVENDT ;inverse end date
107 S WVSTDT=WVSTDT\1,WVSTDT=9999999-WVSTDT ;inverse start date
108 S WVSTDT=WVSTDT_".9999"
109 S WVDFN=0 ;patient dfn
110 F S WVDFN=$O(^RADPT(WVDFN)) Q:'WVDFN D ;RAD/NM patient file
111 .Q:$P($G(^DPT(WVDFN,0)),U,2)'="F" ;not female
112 .Q:'$$VECCHK^WVGETAL1(WVDFN) ;failed vet/non-vet/eligibility code check
113 .S WVDTI=WVENDT ;Because the exam date is inverse the end date will
114 .; will be the lower value.
115 .F S WVDTI=$O(^RADPT(WVDFN,"DT",WVDTI)) Q:'WVDTI!(WVDTI>WVSTDT) D
116 ..S WVCNI=0 ;case number
117 ..F S WVCNI=$O(^RADPT(WVDFN,"DT",WVDTI,"P",WVCNI)) Q:'WVCNI D
118 ...S WVNODE=$G(^RADPT(WVDFN,"DT",WVDTI,"P",WVCNI,0))
119 ...Q:WVNODE=""
120 ...S WVPROC=$P(WVNODE,U,2) ;procedure pointer
121 ...Q:'WVPROC ;no pointer to File 71 (no procedure)
122 ...Q:'$D(WVARRAY(WVPROC)) ;not a WH-related procedure
123 ...S WVRPT=$P(WVNODE,U,17) ;report pointer
124 ...Q:'WVRPT ;no pointer to File 74 (no report)
125 ...Q:$$GET1^DIQ(74,WVRPT,5,"I")'="V" ;report status, must be VERIFIED
126 ...D CREATEH^WVRALINK(WVDFN,WVDTI,WVCNI,WVSTATUS)
127 ...Q
128 ..Q
129 .Q
130 Q
131MAIL ; send mail message to user with counts of procedures & patients added
132 S XMDUZ=.5 ;message sender
133 S XMY(DUZ)="" ;person who ran option
134 S XMSUB="Export of RAD/NM procedures to WH is done"
135 S WVMSG(1)=" # of New patients added to Women's Health package: "_WVNEWP
136 S WVMSG(2)="# of New procedures added to Women's Health package: "_WVMCNT
137 I '$D(WVARRAY) D
138 .S WVMSG(3)=" "
139 .S WVMSG(4)="There are no mammogram or ultrasound procedures listed in your"
140 .S WVMSG(5)="Radiology/Nuclear Medicine package."
141 .Q
142 S XMTEXT="WVMSG("
143 D ^XMD
144 I $D(ZTQUEUED) S ZTREQ="@"
145 Q
146KILL ;
147 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
148 K WVARRAY,WVCNI,WVCPT,WVDFN,WVDTI,WVEC,WVENDT,WVIEN,WVMCNT,WVNEWP,WVNODE,WVPOP,WVPROC,WVRPT,WVSTATUS,WVSTDT
149 K X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
150 Q
151 ;
Note: See TracBrowser for help on using the repository browser.