1 | WVLABLG ;HCIOFO/FT IHS/ANMC/MWR - DISPLAY LAB LOG; ;8/31/98 16:24
|
---|
2 | ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
---|
3 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
---|
4 | ;; CALLED BY OPTION: "WV LAB PRINT LOG" TO PRINT THE "LOG" OF
|
---|
5 | ;; OF PROCEDURES THAT HAVE BEEN ENTERED ("ACCESSIONED").
|
---|
6 | ;
|
---|
7 | ;---> VARIABLES:
|
---|
8 | ;---> DATES: WVBEGDT=BEGINNING DATE, WVENDDT=ENDING DATE
|
---|
9 | ;---> WVA: 1=ALL PROCEDURES, 0=ONLY PROCEDURES WITHOUT RESULTS
|
---|
10 | ;---> WVB: 1=DISPLAY EACH PROCEDURE, 0=TOTALS ONLY
|
---|
11 | ;
|
---|
12 | D SETVARS^WVUTL5 S WVPOP=0
|
---|
13 | D TITLE^WVUTL5("PRINT LOG OF PROCEDURES ENTRY")
|
---|
14 | D DATES G:WVPOP EXIT
|
---|
15 | D SELECT G:WVPOP EXIT
|
---|
16 | D FACILITY G:WVPOP EXIT
|
---|
17 | D RESULT G:WVPOP EXIT
|
---|
18 | D TOTALS G:WVPOP EXIT
|
---|
19 | D ORDER G:WVPOP EXIT
|
---|
20 | D DEVICE G:WVPOP EXIT
|
---|
21 | D SORT
|
---|
22 | D COPYGBL
|
---|
23 | D ^WVLABLG1
|
---|
24 | ;
|
---|
25 | EXIT ;EP
|
---|
26 | D KILLALL^WVUTL8
|
---|
27 | Q
|
---|
28 | ;
|
---|
29 | DATES ;EP
|
---|
30 | ;---> ASK DATE RANGE. RETURN DATES IN WVBEGDT AND WVENDDT.
|
---|
31 | ;---> LAB PEOPLE GENERALLY LOOK AT THE LOG FOR ONE DAY.
|
---|
32 | D ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP,"T-1","",1)
|
---|
33 | Q
|
---|
34 | ;
|
---|
35 | SELECT ;EP
|
---|
36 | ;---> SELECT ENTRIES TO SEARCH FOR.
|
---|
37 | D SELECT^WVSELECT("Accession Area",790.2,"WVAREA","","PAP",.WVPOP)
|
---|
38 | Q
|
---|
39 | ;
|
---|
40 | FACILITY ;EP
|
---|
41 | ;---> SELECT FACILITY TO SEARCH FOR.
|
---|
42 | N B S B=$$INSTTX^WVUTL6(DUZ(2))
|
---|
43 | W !!?3,"Select the Facility for the log you wish to display."
|
---|
44 | D DIC^WVFMAN(790.02,"QEMA",.Y," Select FACILITY: ",B)
|
---|
45 | I Y<0 S WVPOP=1 Q
|
---|
46 | S WVFAC=+Y
|
---|
47 | Q
|
---|
48 | ;
|
---|
49 | RESULT ;EP
|
---|
50 | ;---> DISPLAY ALL PROCEDURES, OR ONLY PROCEDURES WITHOUT RESULTS.
|
---|
51 | N DIR K DIRUT
|
---|
52 | W !!?3,"Display ALL Procedures, or only Procedures with NO RESULTS?"
|
---|
53 | S DIR("A")=" Select ALL or NO RESULTS: ",DIR("B")="ALL"
|
---|
54 | S DIR(0)="SAM^a:ALL;n:NO RESULTS" D HELP1^WVLABLG2
|
---|
55 | D ^DIR
|
---|
56 | I Y=-1!($D(DIRUT)) S WVPOP=1 Q
|
---|
57 | ;---> IF ALL PPROCEDURES, S WVA=1; IF ONLY NO RESULTS, S WVA=0.
|
---|
58 | S WVA=$S(Y="a":1,1:0)
|
---|
59 | Q
|
---|
60 | ;
|
---|
61 | TOTALS ;EP
|
---|
62 | ;---> DISPLAY ALL PROCEDURES, OR ONLY TOTALS.
|
---|
63 | N DIR
|
---|
64 | W !!?3,"Display data for EACH Procedure, or just TOTALS?"
|
---|
65 | S DIR("A")=" Select EACH or TOTALS: ",DIR("B")="EACH"
|
---|
66 | S DIR(0)="SAM^e:EACH;n:TOTALS" D HELP2^WVLABLG2
|
---|
67 | D ^DIR
|
---|
68 | I Y=-1!($D(DIRUT)) S WVPOP=1 Q
|
---|
69 | ;---> IF DISPLAY EACH PROCEDURE, S WVB=1; IF TOTALS ONLY, S WVB=0
|
---|
70 | S WVB=$S(Y="e":1,1:0)
|
---|
71 | Q
|
---|
72 | ;
|
---|
73 | ORDER ;EP
|
---|
74 | ;---> ASK ORDER BY ACCESSION# OR BY PATIENT NAME.
|
---|
75 | ;---> SORT SEQUENCE IN WVC: 1=ACCESSION# (DEFAULT), 2=PATIENT NAME
|
---|
76 | S WVC=1
|
---|
77 | ;---> QUIT IF DISPLAYING TOTALS ONLY.
|
---|
78 | Q:'WVB N DIR,DIRUT,Y
|
---|
79 | W !!?3,"Display Procedures in order of:"
|
---|
80 | W ?37,"1) ACCESSION# (earliest first)"
|
---|
81 | W !?37,"2) PATIENT NAME (alphabetically)"
|
---|
82 | S DIR("A")=" Select 1 or 2: ",DIR("B")=1
|
---|
83 | S DIR(0)="SAM^1:ACCESSION#;2:PATIENT NAME" D HELP3^WVLABLG2
|
---|
84 | D ^DIR
|
---|
85 | I Y=-1!($D(DIRUT)) S WVPOP=1 Q
|
---|
86 | S WVC=Y
|
---|
87 | Q
|
---|
88 | ;
|
---|
89 | DEVICE ;EP
|
---|
90 | ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
|
---|
91 | S ZTRTN="DEQUEUE^WVLABLG"
|
---|
92 | F WVSV="A","B","C","BEGDT","ENDDT","FAC" D
|
---|
93 | .I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
|
---|
94 | ;---> SAVE ATTRIBUTES ARRAY. NOTE: SUBSTITUTE LOCAL ARRAY FOR WVAREA.
|
---|
95 | I $D(WVAREA) N N S N=0 F S N=$O(WVAREA(N)) Q:N="" D
|
---|
96 | .S ZTSAVE("WVAREA("""_N_""")")=""
|
---|
97 | D ZIS^WVUTL2(.WVPOP,1)
|
---|
98 | Q
|
---|
99 | ;
|
---|
100 | SORT ;EP
|
---|
101 | ;---> SORT AND STORE ARRAY IN ^TMP("WV",$J
|
---|
102 | ;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
|
---|
103 | ;---> WVENDDT1=THE LAST SECOND OF END DATE.
|
---|
104 | ;
|
---|
105 | K ^TMP("WV",$J)
|
---|
106 | S WVBEGDT1=WVBEGDT-.0001,WVENDDT1=WVENDDT+.9999
|
---|
107 | S WVDATE=WVBEGDT1
|
---|
108 | F S WVDATE=$O(^WV(790.1,"ADE",WVDATE)) Q:'WVDATE!(WVDATE>WVENDDT1) D
|
---|
109 | .S WVIEN=0
|
---|
110 | .F S WVIEN=$O(^WV(790.1,"ADE",WVDATE,WVIEN)) Q:'WVIEN D
|
---|
111 | ..S Y=^WV(790.1,WVIEN,0),WVDFN=$P(Y,U,2)
|
---|
112 | ..;---> QUIT IF NOT DONE AT THE SELECTED FACILITY.
|
---|
113 | ..Q:$P(Y,U,34)'=WVFAC
|
---|
114 | ..;---> QUIT IF NOT ALL "ACCESSION AREAS" (PROCEDURE TYPES) AND
|
---|
115 | ..;---> THIS DOES NOT MATCH THE SELECTED AREA.
|
---|
116 | ..I '$D(WVAREA("ALL")) Q:$P(Y,U,4)="" Q:'$D(WVAREA($P(Y,U,4)))
|
---|
117 | ..D STORE
|
---|
118 | Q
|
---|
119 | ;
|
---|
120 | ;
|
---|
121 | STORE ;EP
|
---|
122 | ;--->WVDATE IS ALREADY SET FROM LL SORT ABOVE. ;---> DATE
|
---|
123 | S WVCHRT=$$SSN^WVUTL1(WVDFN) ;---> SSN
|
---|
124 | S WVNAME=$$NAME^WVUTL1(WVDFN) ;---> NAME
|
---|
125 | S WVACCN=$P(Y,U) ;---> ACCESSION#
|
---|
126 | S X=$P(Y,U,4),WVPCDN=$$PCDNAM^WVUTL6 ;---> PROC TYPE
|
---|
127 | S WVDIAG=$$DIAG^WVUTL4($P(Y,U,5)) ;---> RESULT/DIAG
|
---|
128 | S WVRES=$O(^WV(790.1,WVIEN,1,0)) ;---> RESULT TEXT
|
---|
129 | ;---> QUIT IF DISPLAYING ONLY PROCEDURES WITH NO RESULTS.
|
---|
130 | Q:'WVA&($P(Y,U,5))
|
---|
131 | S WVPDATE=$$SLDT2^WVUTL5($P(Y,U,12)) ;---> PROC DATE
|
---|
132 | S WVRCVDT=$$SLDT2^WVUTL5($P(Y,U,17)) ;---> RCV RES DAT
|
---|
133 | S X=$P(Y,U,11),WVHLOC=$$HOSPLC^WVUTL6 ;---> HOSP LOC
|
---|
134 | S X=$P(Y,U,7),WVPROV=$$PROV^WVUTL6 ;---> PROVIDER
|
---|
135 | S X=$P(Y,U,18),WVUSER=$$PROV^WVUTL6 ;---> ENTERED BY
|
---|
136 | ;
|
---|
137 | S X=WVCHRT_U_WVNAME_U_WVDATE_U_WVACCN_U_WVPCDN_U_WVRES_U_WVPDATE
|
---|
138 | S X=X_U_WVHLOC_U_WVPROV_U_WVUSER_U_WVRCVDT_U_WVDIAG_U_WVIEN
|
---|
139 | I WVC=1 S ^TMP("WV",$J,1,WVDATE,$P(WVACCN,"-"),$P(WVACCN,"-",2))=X Q
|
---|
140 | I WVC=2 S ^TMP("WV",$J,1,WVDATE,WVNAME,WVACCN)=X Q
|
---|
141 | Q
|
---|
142 | ;
|
---|
143 | COPYGBL ;EP
|
---|
144 | ;---> COPY ^TMP("WV",$J,1 TO ^TMP("WV",$J,2 TO MAKE IT FLAT.
|
---|
145 | N I,M,N,P,Q
|
---|
146 | S N=0,I=0
|
---|
147 | F S N=$O(^TMP("WV",$J,1,N)) Q:N="" D
|
---|
148 | .S M=0
|
---|
149 | .F S M=$O(^TMP("WV",$J,1,N,M)) Q:M="" D
|
---|
150 | ..S P=0
|
---|
151 | ..F S P=$O(^TMP("WV",$J,1,N,M,P)) Q:P="" D
|
---|
152 | ...S I=I+1,^TMP("WV",$J,2,I)=^TMP("WV",$J,1,N,M,P)
|
---|
153 | Q
|
---|
154 | ;
|
---|
155 | DEQUEUE ;EP
|
---|
156 | ;---> TASKMAN QUEUE OF PRINTOUT.
|
---|
157 | D SETVARS^WVUTL5,SORT,COPYGBL,^WVLABLG1,EXIT
|
---|
158 | Q
|
---|