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

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1WVBRPCD ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE PROCEDURES; ;7/30/98 11:07
2 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; CALLED BY OPTION: "WV BROWSE PROCEDURES" TO BROWSE AND EDIT
5 ;; PROCEDURES.
6 ;
7 ;---> VARIABLES:
8 ;---> WVA: 1=ALL PATIENTS, 0=ONE PATIENT
9 ;---> WVDFN: DFN OF SELECTED PATIENT
10 ;---> DATES: WVBEGDT=BEGINNING DATE, WVENDDT=ENDING DATE
11 ;---> WVD: 1=BOTH ABNORMAL AND NORMAL, 0=NORMAL ONLY
12 ;---> SORT SEQUENCE IN WVC: 1=DATE, PATIENT, PRIORITY
13 ;---> 2=PATIENT, DATE, PRIORITY
14 ;---> 3=PRIORITY, DATE, PATIENT
15 ;---> USE NODES 1 & 2 IN ^TMP GLOBAL
16 ;
17 D SETVARS^WVUTL5 S WVPOP=0
18 D ^WVBRPCD2 G:WVPOP EXIT
19 D SORT
20 D COPYGBL
21 ;---> NEXT LINE: PASS TITLE, HEADER (IN ^WVUTL7), AND CODE TO
22 ;---> EXECUTE BY DIR AT BOTTOM OF SCREEN.
23 D DISPLAY^WVBRPCD1(WVTITLE,WVHEADER,WVCODE)
24 ;
25EXIT ;EP
26 D KILLALL^WVUTL8
27 Q
28 ;
29 ;
30SORT ;EP
31 ;---> SORT AND STORE ARRAY IN ^TMP("WV",$J
32 K ^TMP("WV",$J)
33 ;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
34 ;---> WVENDDT1=THE LAST SECOND OF END DATE.
35 S WVBEGDT1=WVBEGDT-.0001,WVENDDT1=WVENDDT+.9999
36 ;
37 ;***********************
38 ;---> WVA=1 ALL PATIENTS
39 I WVA D Q
40 .;---> BY DATE GET EITHER ALL OR ABNORMAL ONLY.
41 .;---> ("INSUFFICIENT TISSUE" IS INCLUDED IN ABNML XREF.)
42 .S WVXREF=$S(WVD:"D",1:"ABNML")
43 .S WVDATE=WVBEGDT1
44 .F S WVDATE=$O(^WV(790.1,WVXREF,WVDATE)) Q:'WVDATE!(WVDATE>WVENDDT1) D
45 ..S WVIEN=0
46 ..F S WVIEN=$O(^WV(790.1,WVXREF,WVDATE,WVIEN)) Q:'WVIEN D
47 ...S Y=^WV(790.1,WVIEN,0),WVDFN=$P(Y,U,2)
48 ...;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
49 ...Q:$P(Y,U,5)=8
50 ...;---> QUIT IF NOT SELECTING FOR ALL PROCEDURES AND IF THIS IS
51 ...;---> NOT ONE OF THE SELECTED PROCEDURES.
52 ...I '$D(WVARR("ALL")) Q:'$D(WVARR($P(Y,U,4)))
53 ...;---> QUIT IF NOT "ALL PROCEDURES" AND THIS ENTRY IS "CLOSED".
54 ...Q:WVB'="a"&($P(Y,U,14)="c")
55 ...;---> QUIT IF SELECTING FOR ONE CASE MANAGER AND THIS DOESN'T MATCH.
56 ...I 'WVE Q:$P(^WV(790,WVDFN,0),U,10)'=WVCMGR
57 ...;---> QUIT IF LISTING "DELINQUENT" AND THIS PROCDURE IS NOT DELINQ.
58 ...I WVB="d" Q:$P(Y,U,13)>DT!($P(Y,U,13)="")
59 ...;---> QUIT IF LISTING "NEW" AND THIS PROCDURE IS NOT NEW.
60 ...;Q:WVB="n"&($P(Y,U,14)'="n")
61 ...D STORE(WVC,WVIEN,Y)
62 ;
63 ;**********************
64 ;---> WVA=0 ONE PATIENT
65 S WVIEN=0
66 F S WVIEN=$O(^WV(790.1,"C",WVDFN,WVIEN)) Q:'WVIEN D
67 .;---> SET Y=THE ZERO NODE FOR THIS PROCEDURE.
68 .S Y=^WV(790.1,WVIEN,0)
69 .;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
70 .Q:$P(Y,U,5)=8
71 .;---> QUIT IF NOT WITHIN DATE RANGE.
72 .S WVDATE=$P(Y,U,12)
73 .Q:WVDATE'>WVBEGDT1!(WVDATE>WVENDDT1)
74 .;---> QUIT IF SELECTING FOR "ABNORMAL" ONLY AND THIS PROCEDURE
75 .;---> "NORMAL". ("INSUFF TISSUE" AND "UNSAT EXAM" WILL BE "ABNORMAL".)
76 .Q:'WVD&('$$NORMAL^WVUTL4($P(Y,U,5)))
77 .;---> QUIT IF "DELINQUENT" OR "OPEN" ONLY AND THIS ENTRY IS "CLOSED".
78 .Q:WVB'="a"&($P(Y,U,14)="c")
79 .;---> QUIT IF LISTING "DELINQUENT" AND THIS PROCDURE IS NOT DELINQ.
80 .I WVB="d" Q:$P(Y,U,13)>DT!($P(Y,U,13)="")
81 .;Q:WVB="n"&($P(Y,U,14)'="n")
82 .D STORE(WVC,WVIEN,Y)
83 Q
84 ;
85STORE(WVC,WVIEN,Y) ;EP
86 ;---> CALLED TO STORE PROCEDURES IN ^TMP FOR BROWSING.
87 ;---> WVC=LIST ORDER, WVIEN=IEN OR PROCEDURE, Y=ZERO NODE OF PROCEDURE.
88 S WVDFN=$P(Y,U,2),WVDATE=$P(Y,U,12) ;---> DFN, DATE
89 S WVCHRT=$$SSN^WVUTL1(WVDFN)_" " ;---> SSN#
90 S WVNAME=$$NAME^WVUTL1(WVDFN) ;---> NAME
91 S WVACC=$P(Y,U) ;---> ACCESSION#
92 S WVSTAT=$E($$STATUS^WVUTL4) ;---> STATUS
93 S WVDIAG=$$DIAG^WVUTL4($P(Y,U,5)) ;---> RESULT/DIAG
94 S X=$P(Y,U,5),WVPRIO=$$PRIOR^WVUTL4 K X ;---> PRIORITY
95 ;
96 S X=WVCHRT_U_WVNAME_U_WVDATE_U_WVACC_U_WVDIAG_U_WVPRIO_U_WVSTAT_U_WVIEN
97 I WVC=1 S ^TMP("WV",$J,1,WVDATE,WVNAME,WVPRIO,WVIEN)=X Q
98 I WVC=2 S ^TMP("WV",$J,1,WVNAME,WVDATE,WVPRIO,WVIEN)=X Q
99 I WVC=3 S ^TMP("WV",$J,1,WVPRIO,WVDATE,WVNAME,WVIEN)=X
100 Q
101 ;
102COPYGBL ;EP
103 ;---> CALLED TO FLATTEN THE ^TMP ARRAY OF PROCEDURES FOR BROWSING.
104 ;---> COPY ^TMP("WV",$J,1 TO ^TMP("WV",$J,2 TO MAKE IT FLAT.
105 N I,M,N,P,Q
106 S N=0,I=0
107 F S N=$O(^TMP("WV",$J,1,N)) Q:N="" D
108 .S M=0
109 .F S M=$O(^TMP("WV",$J,1,N,M)) Q:M="" D
110 ..S P=0
111 ..F S P=$O(^TMP("WV",$J,1,N,M,P)) Q:P="" D
112 ...S Q=0
113 ...F S Q=$O(^TMP("WV",$J,1,N,M,P,Q)) Q:Q="" D
114 ....S I=I+1,^TMP("WV",$J,2,I)=^TMP("WV",$J,1,N,M,P,Q)
115 Q
116 ;
117DEQUEUE ;EP
118 ;---> FOR TASKMAN QUEUE OF PRINTOUT.
119 D SETVARS^WVUTL5,SORT,COPYGBL
120 D DISPLAY^WVBRPCD1(WVTITLE,WVHEADER,WVCODE)
121 D EXIT
122 Q
Note: See TracBrowser for help on using the repository browser.