1 | PXRRLCSC ;ISL/PKR - PCE reports locations selection criteria routines. ;4/8/97
|
---|
2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**12,18,20,72**;Aug 12, 1996
|
---|
3 | ;
|
---|
4 | ;=======================================================================
|
---|
5 | BYLOC ;Ask if the report should be broken down by clinic location or clinic
|
---|
6 | ;stop
|
---|
7 | N X,Y
|
---|
8 | K DIROUT,DIRUT,DTOUT,DUOUT
|
---|
9 | S DIR(0)="S"_U_"L:Location;"
|
---|
10 | S DIR(0)=DIR(0)_"S:Stop"
|
---|
11 | S DIR("A")="Do you want totals by Clinic Location or Clinic Stop?"
|
---|
12 | S DIR("B")="L"
|
---|
13 | D ^DIR K DIR
|
---|
14 | I Y="L" S $P(PXRRLCSC,U,3)=1
|
---|
15 | I $D(DIROUT) S DTOUT=1
|
---|
16 | I $D(DTOUT)!($D(DUOUT)) Q
|
---|
17 | Q
|
---|
18 | ;
|
---|
19 | ;=======================================================================
|
---|
20 | CSTOP ;Get a list of clinic stop codes.
|
---|
21 | K DTOUT,DUOUT
|
---|
22 | S NCS=0
|
---|
23 | S DIC("A")="Select CLINIC STOP: "
|
---|
24 | W !
|
---|
25 | NSTOP ;Select the clinic stop codes.
|
---|
26 | S DIC=40.7
|
---|
27 | S DIC(0)="AEMQZ"
|
---|
28 | I NCS'<1 S DIC("A")="Select another CLINIC STOP: "
|
---|
29 | D ^DIC K DIC
|
---|
30 | I X=(U_U) S DTOUT=1
|
---|
31 | I $D(DTOUT)!($D(DUOUT)) Q
|
---|
32 | I (NCS=0)&(+Y=-1) W !,"You must select a clinic stop!" G CSTOP
|
---|
33 | I +Y'=-1 D G NSTOP
|
---|
34 | . S NCS=NCS+1
|
---|
35 | .;Save the external form of the name, the IEN, and the stop code.
|
---|
36 | . S PXRRCS(NCS)=$P(Y(0,0),U,1)_U_$P(Y,U,1)_U_$P(Y(0),U,2)
|
---|
37 | ;Sort the clinic stop list into alphabetical order.
|
---|
38 | S NCS=$$SORT^PXRRUTIL(NCS,"PXRRCS",2)
|
---|
39 | Q
|
---|
40 | ;
|
---|
41 | ;=======================================================================
|
---|
42 | FACILITY ;Get the facility list.
|
---|
43 | N IC,STATION,X,Y
|
---|
44 | K DIRUT,DTOUT,DUOUT
|
---|
45 | S NFAC=0
|
---|
46 | S DIC("B")=+$P($$SITE^VASITE,U,3)
|
---|
47 | S DIC("A")="Select FACILITY: "
|
---|
48 | W !
|
---|
49 | FAC ;Select the facilities.
|
---|
50 | S DIC=4
|
---|
51 | S DIC(0)="AEMQZ"
|
---|
52 | I NFAC'<1 S DIC("A")="Select another FACILITY: "
|
---|
53 | D ^DIC K DIC
|
---|
54 | I X=(U_U) S DTOUT=1
|
---|
55 | I $D(DTOUT)!($D(DUOUT)) Q
|
---|
56 | I +Y'=-1 D G FAC
|
---|
57 | . S NFAC=NFAC+1
|
---|
58 | . S PXRRFAC(NFAC)=Y_U_Y(0,0)
|
---|
59 | ;
|
---|
60 | ;Save the facility names and station.
|
---|
61 | ;We will probably need a DBIA to read DIC(4.
|
---|
62 | F IC=1:1:NFAC D
|
---|
63 | . S X=$P(PXRRFAC(IC),U,1)
|
---|
64 | . S STATION=$P($G(^DIC(4,X,99)),U,1)
|
---|
65 | . S PXRRFACN(X)=$P(PXRRFAC(IC),U,2)_U_STATION
|
---|
66 | ;
|
---|
67 | ;Ask user whether they want to display non-va sites
|
---|
68 | S DIR(0)="Y"_U_"N:No;"
|
---|
69 | S DIR(0)=DIR(0)_"Y:Yes"
|
---|
70 | W !
|
---|
71 | S DIR("A")="Do you want to display encounters at Non-VA sites "
|
---|
72 | S DIR("B")="N"
|
---|
73 | D ^DIR K DIR
|
---|
74 | I +Y=1 D
|
---|
75 | . S NFAC=NFAC+1
|
---|
76 | . S PXRRFACN("*")="NON-VA^*"
|
---|
77 | . S PXRRFAC(NFAC)="*^NON-VA^NON-VA"
|
---|
78 | . S NONVA=1
|
---|
79 | ;
|
---|
80 | ;Sort the facility list into alphabetical order.
|
---|
81 | S NFAC=$$SORT^PXRRUTIL(NFAC,"PXRRFAC",2)
|
---|
82 | Q
|
---|
83 | ;
|
---|
84 | ;=======================================================================
|
---|
85 | HLOC ;Build a list of hospital locations.
|
---|
86 | N IEN,SC,X,Y
|
---|
87 | K DTOUT,DUOUT
|
---|
88 | S NHL=0
|
---|
89 | S DIC="^SC("
|
---|
90 | S DIC(0)="AEQMZ"
|
---|
91 | S DIC("A")="Select HOSPITAL LOCATION: "
|
---|
92 | W !
|
---|
93 | NHLOC I NHL'<1 S DIC("A")="Select another HOSPITAL LOCATION: "
|
---|
94 | D ^DIC
|
---|
95 | I X=(U_U) S DTOUT=1
|
---|
96 | I $D(DTOUT)!($D(DUOUT)) Q
|
---|
97 | I +Y'=-1 D G NHLOC
|
---|
98 | . S NHL=NHL+1
|
---|
99 | . S IEN=$P(Y,U,1)
|
---|
100 | .;Get the stop code.
|
---|
101 | .;These will probably require a DBIA.
|
---|
102 | . S X=$P(^SC(IEN,0),U,7)
|
---|
103 | . I +X>0 S SC=$P(^DIC(40.7,X,0),U,2)
|
---|
104 | . E S SC="Unknown"
|
---|
105 | . I $L(SC)=0 S SC="Unknown"
|
---|
106 | .;Save the IEN, the external form of the name, and the stop code.
|
---|
107 | . S PXRRLCHL(NHL)=IEN_U_$P(Y(0,0),U,1)_U_SC
|
---|
108 | .;Save the external form of the name, then IEN, and the stop code.
|
---|
109 | . S PXRRLCHL(NHL)=$P(Y(0,0),U,1)_U_IEN_U_SC
|
---|
110 | E K DIC
|
---|
111 | I $D(DUOUT) G HLOC
|
---|
112 | I (NHL=0)&(+Y=-1) W !,"You must select a hospital location!" G HLOC
|
---|
113 | ;Sort the hospital location list into alphabetical order.
|
---|
114 | S NHL=$$SORT^PXRRUTIL(NHL,"PXRRLCHL",2)
|
---|
115 | Q
|
---|
116 | ;
|
---|
117 | ;=======================================================================
|
---|
118 | LOC(ADEF,BDEF) ;Establish the location selection criteria.
|
---|
119 | N X,Y
|
---|
120 | LOC0 K DIROUT,DIRUT,DTOUT,DUOUT
|
---|
121 | S DIR(0)="S"_U_"HA:All Hospital Locations (with encounters);"
|
---|
122 | S DIR(0)=DIR(0)_"HS:Selected Hospital Locations;"
|
---|
123 | S DIR(0)=DIR(0)_"CA:All Clinic Stops (with encounters);"
|
---|
124 | S DIR(0)=DIR(0)_"CS:Selected Clinic Stops"
|
---|
125 | S DIR("A")=ADEF
|
---|
126 | S DIR("B")=BDEF
|
---|
127 | D ^DIR K DIR
|
---|
128 | I $D(DIROUT) S DTOUT=1
|
---|
129 | I $D(DTOUT)!($D(DUOUT)) Q
|
---|
130 | S PXRRLCSC=Y_U_Y(0)
|
---|
131 | ;
|
---|
132 | ;If locations are to be selected individually get the list.
|
---|
133 | I Y="HS" D HLOC
|
---|
134 | I $D(DTOUT) Q
|
---|
135 | I $D(DUOUT) G LOC0
|
---|
136 | I Y="CS" D CSTOP
|
---|
137 | I $D(DTOUT) Q
|
---|
138 | I $D(DUOUT) G LOC0
|
---|
139 | Q
|
---|
140 | ;
|
---|
141 | ;=======================================================================
|
---|
142 | NEWPAGE ;Allow the user to decide if they want each location to start on a new
|
---|
143 | ;page.
|
---|
144 | N X,Y
|
---|
145 | K DIROUT,DIRUT,DTOUT,DUOUT
|
---|
146 | S DIR(0)="YA0"
|
---|
147 | S DIR("A")="Want to start each location on a new page: "
|
---|
148 | S DIR("B")="Y"
|
---|
149 | W !
|
---|
150 | D ^DIR K DIR
|
---|
151 | I $D(DIROUT) S DTOUT=1
|
---|
152 | I $D(DTOUT)!($D(DUOUT)) Q
|
---|
153 | S PXRRLCNP=Y_U_Y(0)
|
---|
154 | Q
|
---|
155 | ;
|
---|