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

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1WVLABLG ;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 ;
25EXIT ;EP
26 D KILLALL^WVUTL8
27 Q
28 ;
29DATES ;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 ;
35SELECT ;EP
36 ;---> SELECT ENTRIES TO SEARCH FOR.
37 D SELECT^WVSELECT("Accession Area",790.2,"WVAREA","","PAP",.WVPOP)
38 Q
39 ;
40FACILITY ;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 ;
49RESULT ;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 ;
61TOTALS ;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 ;
73ORDER ;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 ;
89DEVICE ;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 ;
100SORT ;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 ;
121STORE ;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 ;
143COPYGBL ;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 ;
155DEQUEUE ;EP
156 ;---> TASKMAN QUEUE OF PRINTOUT.
157 D SETVARS^WVUTL5,SORT,COPYGBL,^WVLABLG1,EXIT
158 Q
Note: See TracBrowser for help on using the repository browser.