source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVBRPCD2.m@ 724

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1WVBRPCD2 ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE PROCEDURES;
2 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; PROMPTS FOR SELECTION CRITERIA IN BROWSING PROCEDURES.
5 ;; CALLED BY WVBRPCD.
6 ;
7 D TITLE^WVUTL5("BROWSE PROCEDURES")
8 D ONEALL Q:WVPOP
9 D SELECT Q:WVPOP
10 D DATES Q:WVPOP
11 D STATUS Q:WVPOP
12 D RESULT Q:WVPOP
13 D CMGR Q:WVPOP
14 D ORDER Q:WVPOP
15 D DEVICE Q:WVPOP
16 Q
17 ;
18ONEALL ;EP
19 ;---> SELECT ONE PATIENT OR ALL PATIENTS.
20 N DIR,DIRUT,Y
21 W !!?3,"Browse Procedures for ONE individual patient,"
22 W !?3,"or browse Procedures for ALL patients?"
23 S DIR("A")=" Select ONE or ALL: ",DIR("B")="ALL"
24 S DIR(0)="SAM^o:ONE;a:ALL" D HELP2^WVBRPCD3
25 D ^DIR
26 I Y=-1!($D(DIRUT)) S WVPOP=1 Q
27 ;---> IF ALL PATIENTS, S WVA=1 AND QUIT.
28 I Y="a" S WVA=1 Q
29 ;
30 W !!," Select the patient whose Procedures you wish to browse."
31 D PATLKUP^WVUTL8(.Y)
32 I Y<0 S WVPOP=1 Q
33 ;---> FOR ONE PATIENT, SET WVA=0 AND WVDFN=PATIENT DFN, QUIT.
34 S WVDFN=+Y,WVA=0,WVCMGR=$P(^WV(790,WVDFN,0),U,10)
35 Q
36 ;
37SELECT ;EP
38 ;---> SELECT THE PROCEDURES TO BROWSE.
39 D SELECT^WVSELECT("Procedure Type",790.2,"WVARR","","PAP",.WVPOP)
40 Q
41 ;
42DATES ;EP
43 ;---> ASK DATE RANGE. RETURN DATES IN WVBEGDT AND WVENDDT.
44 ;---> IF LOOKING AT ONLY ONE PATIENT, SET DEFAULT BEGIN DATE=T-365.
45 S WVBEGDF=$S(WVA:"T-30",1:"T-365")
46 D ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP,WVBEGDF,"T")
47 Q
48 ;
49STATUS ;EP
50 ;---> GET XREF: OPEN OR ALL
51 N DIR,DIRUT,Y W !!?3
52 W "Do you wish to browse DELINQUENT, OPEN, or ALL Procedures?"
53 S DIR("A")=" Select DELINQUENT, OPEN or ALL: ",DIR("B")="OPEN"
54 S DIR(0)="SAM^d:DELINQUENT;o:OPEN;a:ALL" D HELP4^WVBRPCD3
55 D ^DIR
56 I Y=-1!($D(DIRUT)) S WVPOP=1 Q
57 S WVB=Y
58 Q
59 ;
60RESULT ;EP
61 ;---> GET XREF: ABNORMAL OR ALL
62 N DIR,DIRUT,Y
63 W !!?3,"Do you wish to browse only Procedures with ABNORMAL results, "
64 W !?3,"or both ABNORMAL and NORMAL?"
65 S DIR("A")=" Select ABNORMAL or BOTH: "
66 S DIR("B")="ABNORMAL ONLY" D HELP1^WVBRPCD3
67 S DIR(0)="SAM^a:ABNORMAL ONLY;b:BOTH ABNORMAL AND NORMAL"
68 D ^DIR
69 I Y=-1!($D(DIRUT)) S WVPOP=1 Q
70 S WVD=$S(Y="a":0,1:1)
71 Q
72 ;
73CMGR ;EP
74 ;---> SELECT CASES FOR ONE CASE MANAGER OR ALL.
75 ;---> DO NOT PROMPT FOR CASE MANAGER IF SITE PARAMETERS SAY NOT TO,
76 ;---> OR IF LOOKING AT PROCEDURES FOR ONLY ONE PATIENT.
77 N DIR,DIRUT,Y
78 I '$D(^WV(790.02,DUZ(2),0)) S WVE=1 Q
79 I '$P(^WV(790.02,DUZ(2),0),U,5)!('WVA) S WVE=1 Q
80 W !!?3,"Browse Procedures for ONE particular Case Manager,"
81 W !?3,"or browse Procedures for ALL Case Managers?"
82 S DIR("A")=" Select ONE or ALL: ",DIR("B")="ALL"
83 S DIR(0)="SAM^o:ONE;a:ALL" D HELP5^WVBRPCD3
84 D ^DIR
85 I Y=-1!($D(DIRUT)) S WVPOP=1 Q
86 ;---> IF ALL CASE MANAGERS, S WVE=1 AND QUIT.
87 I Y="a" S WVE=1 Q
88 N DIC
89 W !!," Select the Case Manager whose patients you wish to browse."
90 D DIC^WVFMAN(790.01,"QEMA",.Y," Select CASE MANAGER: ")
91 I Y<0 S WVPOP=1 Q
92 ;---> FOR ONE CASE MANAGER, SET WVE=0 AND WVCMGR=^VA(200 DFN, QUIT.
93 S WVCMGR=+Y,WVE=0
94 Q
95 ;
96ORDER ;EP
97 ;---> ASK ORDER BY DATE OR BY PATIENT OR BY PRIORITY.
98 ;---> IF LOOKING AT ONLY ONE PATIENT, ORDER BY DATE AND QUIT.
99 I 'WVA S WVC=1 D TITLE Q
100 ;
101 ;---> SORT SEQUENCE IN WVC: 1=DATE, PATIENT, PRIORITY
102 ;---> 2=PATIENT, DATE, PRIORITY
103 ;---> 3=PRIORITY, DATE, PATIENT
104 ;
105 N DIR,DIRUT,Y
106 W !!?3,"Display Procedures in order of:"
107 W ?37,"1) DATE OF PROCEDURE (earliest first)"
108 W !?37,"2) NAME OF PATIENT (alphabetically)"
109 W !?37,"3) PRIORITY (most urgent being highest)"
110 S DIR("A")=" Select 1, 2, or 3: ",DIR("B")=1
111 S DIR(0)="SAM^1:DATE;2:NAME;3:PRIORITY" D HELP3^WVBRPCD3
112 D ^DIR
113 I Y=-1!($D(DIRUT)) S WVPOP=1 Q
114 S WVC=Y D TITLE
115 Q
116 ;
117TITLE ;EP
118 ;---> SET TITLE OF REPORT BASED ON ORDER SELECTED ABOVE.
119 N Y S Y=$S(WVC=1:"DATE",WVC=2:"PATIENT",WVC=3:"DIAGNOSIS",1:"?")
120 S WVTITLE="* * * PROCEDURES LISTED BY "_Y_" * * *"
121 S WVCODE="D EDIT^WVBRPCD1,SORT^WVBRPCD,COPYGBL^WVBRPCD"
122 S WVHEADER="HEADER1"
123 Q
124 ;
125DEVICE ;EP
126 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
127 S ZTRTN="DEQUEUE^WVBRPCD"
128 F WVSV="A","B","C","CODE","D","E","CMGR" D
129 .I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
130 F WVSV="DFN","BEGDT","ENDDT","HEADER","TITLE" D
131 .I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
132 ;---> SAVE THE SELECTED PROCEDURES ARRAY.
133 I $D(WVARR) N N S N=0 F S N=$O(WVARR(N)) Q:N="" D
134 .S ZTSAVE("WVARR("""_N_""")")=""
135 D ZIS^WVUTL2(.WVPOP,1,"HOME")
136 Q
Note: See TracBrowser for help on using the repository browser.