source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVBRDUP.m

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1WVBRDUP ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE DUPLICATE PROCEDURES;
2 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; CALLED BY OPTION: "WV BROWSE PROCEDURES DUPLICATE" TO IDENTIFY,
5 ;; LIST AND BROWSE POSSIBLE DUPLICATE PROCEDURES.
6 ;
7 ;---> USE ^WVBRPCD ROUTINES FOR DISPLAY (NODES 1 & 2 IN ^TMP GLOBAL).
8 ;
9 D SETVARS
10 D TITLE^WVUTL5("BROWSE PROCEDURES FOR POSSIBLE DUPLICATES")
11 D DEVICE G:WVPOP EXIT
12 D SORT
13 D COPYGBL^WVBRPCD
14 D DISPLAY^WVBRPCD1(WVTITLE,WVHEADER,WVCODE)
15 ;
16EXIT ;EP
17 D KILLALL^WVUTL8
18 Q
19 ;
20SETVARS ;EP
21 ;---> SET REQUIRED VARIABLES.
22 D SETVARS^WVUTL5 S WVPOP=0
23 S WVTITLE="* * * DUPLICATE PROCEDURES LISTED BY PATIENT * * *"
24 ;---> SET CODE EXCECUTED BY DIR PROMPT.
25 S WVCODE="D EDIT^WVBRPCD1,SORT^WVBRDUP,COPYGBL^WVBRPCD"
26 ;---> SET LINE LABEL IN ^WVUTL7 TO CALL AS HEADER.
27 S WVHEADER="HEADER6"
28 Q
29 ;
30SORT ;EP
31 ;---> SORT AND STORE ARRAY IN ^TMP("WV",$J
32 K ^TMP("WV",$J) N WVDFN,WVIEN,WVPCD,WVPCDS,N,M,P,Y
33 S WVDFN=0
34 F S WVDFN=$O(^WV(790.1,"C",WVDFN)) Q:'WVDFN D
35 .;
36 .;---> GATHER ALL PROCEDURES FOR THIS PATIENT INTO WVPCDS ARRAY.
37 .S WVIEN=0 K WVPCDS
38 .F S WVIEN=$O(^WV(790.1,"C",WVDFN,WVIEN)) Q:'WVIEN D
39 ..;---> SET Y=THE ZERO NODE FOR THIS PROCEDURE.
40 ..S Y=^WV(790.1,WVIEN,0)
41 ..;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
42 ..Q:$P(Y,U,5)=8
43 ..;---> GET DATE.
44 ..S WVPCD=$P(Y,U,4),WVDATE=$P($P(Y,U,12),".")
45 ..S WVPCDS(WVDFN,WVDATE,WVPCD,WVIEN)=""
46 .;
47 .;---> NOW CHECK WVPCDS ARRAY FOR DUPLICATES.
48 .S N=0
49 .F S N=$O(WVPCDS(WVDFN,N)) Q:'N D
50 ..S M=0
51 ..F S M=$O(WVPCDS(WVDFN,N,M)) Q:'M D
52 ...S P=0
53 ...F I=0:1 S P=$O(WVPCDS(WVDFN,N,M,P)) Q:'P
54 ...Q:I'>1
55 ...S P=0
56 ...F S P=$O(WVPCDS(WVDFN,N,M,P)) Q:'P D
57 ....S Y=^WV(790.1,P,0) D STORE^WVBRPCD(2,P,Y)
58 Q
59 ;
60DEQUEUE ;EP
61 ;---> FOR TASKMAN QUEUE OF PRINTOUT.
62 D SETVARS,SORT,COPYGBL^WVBRPCD
63 D DISPLAY^WVBRPCD1(WVTITLE,WVHEADER,WVCODE)
64 D EXIT
65 Q
66 ;
67DEVICE ;EP
68 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
69 S ZTRTN="DEQUEUE^WVBRDUP"
70 F WVSV="HEADER" D
71 .I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
72 D ZIS^WVUTL2(.WVPOP,1,"HOME")
73 Q
Note: See TracBrowser for help on using the repository browser.