1 | WVBRPCD ;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 | ;
|
---|
25 | EXIT ;EP
|
---|
26 | D KILLALL^WVUTL8
|
---|
27 | Q
|
---|
28 | ;
|
---|
29 | ;
|
---|
30 | SORT ;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 | ;
|
---|
85 | STORE(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 | ;
|
---|
102 | COPYGBL ;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 | ;
|
---|
117 | DEQUEUE ;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
|
---|