1 | ACKQASU1 ;HCIOFO/BH-Quasar New Visit Utilities routine ; 04/01/99
|
---|
2 | ;;3.0;QUASAR;;Feb 11, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
---|
4 | ;
|
---|
5 | CLIN(ACKDIV,ACKOPT) ; prompt for clinic
|
---|
6 | ; inputs: - ACKDIV - selected Division
|
---|
7 | ; ACKOPT - set to U to force uppercase entry
|
---|
8 | ; returns: 0 - if no valid clinics to select from
|
---|
9 | ; null - if no clinic selected
|
---|
10 | ; or X^Y^ where
|
---|
11 | ; X - ien of selected clinic
|
---|
12 | ; & Y - clinic name
|
---|
13 | ;
|
---|
14 | N ACKIEN,ACKDEF,ACKCLINN,ACKC,ACKCLIN,ACKDFLT
|
---|
15 | ;
|
---|
16 | ; get the clinics for the selected Division
|
---|
17 | D GETCLIN(ACKDIV,.CLINVARR,$G(ACKOPT))
|
---|
18 | ;
|
---|
19 | ; if no valid clinics then exit
|
---|
20 | I CLINVARR=0 S ACKCLIN=0 G CLINX
|
---|
21 | ;
|
---|
22 | ; only one clinic exists, select it then exit
|
---|
23 | I CLINVARR=1 D G CLINX
|
---|
24 | . S ACKCLIN=$P(CLINVARR(1,1),U,1,2)_U
|
---|
25 | ;
|
---|
26 | ; find users last clinic selection
|
---|
27 | S ACKDEF=$$FIND1^DIC(509850.831,","_ACKDIV_",1,",""," ")
|
---|
28 | S ACKDEF=$S(ACKDEF:$$EXTERNAL^DILFD(509850.831,".01","",ACKDEF),1:"")
|
---|
29 | ;
|
---|
30 | ; ensure users last selection is valid
|
---|
31 | S ACKDEF=$$UP("U",ACKDEF) ; convert to uppercase
|
---|
32 | I ACKDEF'="",'$D(CLINVARR(2,ACKDEF)) S ACKDEF=""
|
---|
33 | S ACKDFLT=$S(ACKDEF="":"",1:"2^"_ACKDEF) ; passed to input fnctn as default
|
---|
34 | ;
|
---|
35 | ; multiple clinics exist, only one required.
|
---|
36 | I CLINVARR>1 D G CLINX
|
---|
37 | . D SELECT^ACKQSEL(1,"CLINVARR(2)","CLINVARR(4)","CLINIC^35","D CLINHLP^ACKQASU1",ACKDFLT)
|
---|
38 | . ; get CLINIC IEN
|
---|
39 | . I $O(CLINVARR(4,""))="" S ACKCLIN="" Q ; quit or timed out
|
---|
40 | . S ACKCLINN=$O(CLINVARR(4,"")),ACKC=CLINVARR(2,ACKCLINN)
|
---|
41 | . S ACKIEN=$P(CLINVARR(1,ACKC),U,1)
|
---|
42 | . D RECALL^DILFD(509850.831,ACKIEN_","_ACKDIV_",1,",DUZ)
|
---|
43 | . S ACKCLIN=$P(CLINVARR(1,ACKC),U,1,2)_U
|
---|
44 | ;
|
---|
45 | CLINX ; end
|
---|
46 | Q ACKCLIN
|
---|
47 | ;
|
---|
48 | CLINHLP ; displays help text for the clinic prompt
|
---|
49 | N X,DIWL,DIWR,DIWF
|
---|
50 | S DIWL=1,DIWR=80,DIWF=""
|
---|
51 | ;
|
---|
52 | S X=" " D ^DIWP
|
---|
53 | S X=" Enter the name of a Clinic from the A&SP Site Parameters File." D ^DIWP
|
---|
54 | S X=" Enter '??' to see a list of the available Clinics, '^' to exit." D ^DIWP
|
---|
55 | D ^DIWW
|
---|
56 | Q
|
---|
57 | ;
|
---|
58 | ;
|
---|
59 | GETCLIN(ACKDIV,CLINVARR,ACKOPT) ; get all the valid clinics and put them in CLINVARR
|
---|
60 | ;
|
---|
61 | ; INPUT: ACKDIV - the selected Division
|
---|
62 | ; CLINVARR - array used to return clinics (passed by reference)
|
---|
63 | ; ACKOPT - set to U for Uppercase entry only
|
---|
64 | ; RETURNS: CLINVARR= number found (n)
|
---|
65 | ; CLINVARR(1,n)=x^name
|
---|
66 | ; CLINVARR(2,name)=n
|
---|
67 | ; and CLINVARR(3,x)=n
|
---|
68 | ; where x=IEN of clinic from parameters file
|
---|
69 | ; and name=the clinic name
|
---|
70 | ;
|
---|
71 | N ACKTGT,ACKMSG,ACKSCRN,ACK,CLIN,CLINNAME
|
---|
72 | K CLINVARR
|
---|
73 | D LIST^DIC(509850.831,","_ACKDIV_",1,",".01","I","*","","","","","","ACKTGT","ACKMSG")
|
---|
74 | ; now transfer to output array
|
---|
75 | S CLINVARR=$P(ACKTGT("DILIST",0),U,1)
|
---|
76 | FOR ACK=1:1:CLINVARR D
|
---|
77 | . S CLIN=ACKTGT("DILIST",1,ACK)
|
---|
78 | . S CLINNAME=$$GET1^DIQ(44,CLIN,.01)
|
---|
79 | . S CLINVARR(1,ACK)=CLIN_U_CLINNAME
|
---|
80 | . S CLINVARR(2,$$UP($G(ACKOPT),CLINNAME))=ACK
|
---|
81 | . S CLINVARR(3,CLIN)=ACK
|
---|
82 | Q
|
---|
83 | ;
|
---|
84 | UP(ACKOPT,X) ; Convert X to uppercase (if requested)
|
---|
85 | I ACKOPT["U" Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
---|
86 | Q X
|
---|
87 | ;
|
---|
88 | DUPCHK(ACKPAT,ACKVD) ; Check for Duplicate Visit by this patient on this Date
|
---|
89 | ; this function will determine if the patient has another visit on
|
---|
90 | ; the selected date. If so the user may choose to select an
|
---|
91 | ; existing visit, or confirm that they are entering a new visit.
|
---|
92 | ; inputs: ACKPAT - patient DFN
|
---|
93 | ; ACKVD - visit date
|
---|
94 | ; returns: -1 if user quit or timed out
|
---|
95 | ; 0 create a new visit
|
---|
96 | ; (ie either no duplicates or user did not select
|
---|
97 | ; a duplicate)
|
---|
98 | ; >0 ien of selected visit
|
---|
99 | ;
|
---|
100 | N ACKVIEN,ACKTGT,ACKCP,ACKCLN,ACKVSC,ACKTIME,ACKCT,ACKVSEL,ACKSEL
|
---|
101 | N X,Y,%,DIR,ACKSEQ,ACKTIME,ACKVSEL
|
---|
102 | S ACKVSEL=0 ; return variable
|
---|
103 | ;
|
---|
104 | ; initialise temp file for data storage
|
---|
105 | K ^TMP("ACKQASU1",$J,"DUPCHK")
|
---|
106 | ;
|
---|
107 | ; get all visits for patient on given date, create array in time order
|
---|
108 | S ACKVIEN=0,ACKCT=0
|
---|
109 | F S ACKVIEN=$O(^ACK(509850.6,"APD",ACKPAT,ACKVD,ACKVIEN)) Q:'ACKVIEN D
|
---|
110 | . K ACKTGT S ACKCT=ACKCT+1
|
---|
111 | . D GETS^DIQ(509850.6,ACKVIEN_",","2.5;2.6;4;55","I","ACKTGT")
|
---|
112 | . S ACKCP=ACKTGT(509850.6,ACKVIEN_",",2.5,"I") ; is this C&P?
|
---|
113 | . S ACKCLN=ACKTGT(509850.6,ACKVIEN_",",2.6,"I") ; clinic
|
---|
114 | . S ACKVSC=ACKTGT(509850.6,ACKVIEN_",",4,"I") ; visit stop code
|
---|
115 | . S ACKTM=+ACKTGT(509850.6,ACKVIEN_",",55,"I") ; appointment time
|
---|
116 | . S ^TMP("ACKQASU1",$J,"DUPCHK",1,ACKTM,ACKVIEN)=""
|
---|
117 | . S ^TMP("ACKQASU1",$J,"DUPCHK",2,ACKVIEN)=ACKVD_U_ACKCP_U_ACKCLN_U_ACKVSC_U_ACKTM_U
|
---|
118 | ;
|
---|
119 | ; if no duplicate visits found then exit
|
---|
120 | I 'ACKCT S ACKVSEL=0 G DUPCHKX
|
---|
121 | ;
|
---|
122 | ; Display duplicates for this patient today
|
---|
123 | W !,$S(ACKCT=1:"One visit has ",1:ACKCT_" visits have ")_"already been entered for this date and patient.",!
|
---|
124 | ;
|
---|
125 | ; run down the visits in time order, allocate sequence number and display
|
---|
126 | S ACKTM="",ACKSEQ=0
|
---|
127 | F S ACKTM=$O(^TMP("ACKQASU1",$J,"DUPCHK",1,ACKTM)) Q:ACKTM="" D
|
---|
128 | . S ACKVIEN=""
|
---|
129 | . F S ACKVIEN=$O(^TMP("ACKQASU1",$J,"DUPCHK",1,ACKTM,ACKVIEN)) Q:ACKVIEN="" D
|
---|
130 | . . S ACKSEQ=ACKSEQ+1
|
---|
131 | . . S $P(^TMP("ACKQASU1",$J,"DUPCHK",3,ACKSEQ),U,1)=ACKVIEN
|
---|
132 | . . S TMP=^TMP("ACKQASU1",$J,"DUPCHK",2,ACKVIEN)
|
---|
133 | . . S ACKTIME=$$FMT^ACKQUTL6(ACKTM,1)
|
---|
134 | . . S ACKVD=$P(TMP,U,1)
|
---|
135 | . . S ACKCANDP=$S($P(TMP,U,2):"C&P EXAM",1:"")
|
---|
136 | . . S ACKCLN=$P(TMP,U,3),ACKCLNNM=$S(+ACKCLN=0:"",1:$$GET1^DIQ(44,ACKCLN_",",.01,"E")) ; clinic name
|
---|
137 | . . S ACKVSC=$P(TMP,U,4),ACKSTOP=$$ACKSTOP(ACKVSC) ; visit stop code
|
---|
138 | . . ; display visits
|
---|
139 | . . W !,$J(ACKSEQ,3),". ",$$DATE(ACKVD)
|
---|
140 | . . W ?20,ACKTIME,?32,$E(ACKCLNNM,1,30),?64,ACKSTOP,?70,ACKCANDP
|
---|
141 | ;
|
---|
142 | ASK1 ; ask if one of the displayed visits is the one to be edited
|
---|
143 | W !!,"Is "_$S(ACKCT=1:"the appointment",1:"one of the appointments")
|
---|
144 | W " shown here the one you wish to edit"
|
---|
145 | S %=2 D YN^DICN
|
---|
146 | I %=-1,%Y?1"^"1.E W !,"Jumping not allowed." G ASK1
|
---|
147 | ;
|
---|
148 | ; if user does not want an existing visit then exit
|
---|
149 | I %=2 D S ACKVSEL=0 G DUPCHKX
|
---|
150 | . W !!,"Ok, adding another visit for this patient/date.",!!
|
---|
151 | ; if user quit or timed out then exit
|
---|
152 | I %="-1" S ACKVSEL=-1 G DUPCHKX
|
---|
153 | ; if any value other than YES, display help and re-prompt
|
---|
154 | I %'=1 S ACKQHLP=2 D ^ACKQHLP G ASK1
|
---|
155 | ;
|
---|
156 | ; if the user answered YES and there is only one visit then exit
|
---|
157 | I ACKCT=1 S ACKVSEL=$P(^TMP("ACKQASU1",$J,"DUPCHK",3,1),U,1) G DUPCHKX
|
---|
158 | ;
|
---|
159 | SELECT ; prompt for which visit
|
---|
160 | S DIR(0)="N^1:"_ACKSEQ
|
---|
161 | S DIR("A")="Select by number"
|
---|
162 | S DIR("?")="Select the appointment you wish to edit from the above list"
|
---|
163 | D ^DIR K DIR
|
---|
164 | I $D(DIRUT) S ACKVSEL=-1 G DUPCHKX ; quit or timed out
|
---|
165 | S ACKSEL=+Y
|
---|
166 | ; get selected Visit ien
|
---|
167 | S ACKVSEL=$P(^TMP("ACKQASU1",$J,"DUPCHK",3,ACKSEL),U,1)
|
---|
168 | ;
|
---|
169 | DUPCHKX ; exit point
|
---|
170 | K ^TMP("ACKQASU1",$J,"DUPCHK")
|
---|
171 | Q ACKVSEL
|
---|
172 | ;
|
---|
173 | ACKSTOP(ACKVSC) ; translate visit stop code for display
|
---|
174 | I ACKVSC="A" Q "AUD"
|
---|
175 | I ACKVSC="S" Q "SPE"
|
---|
176 | I ACKVSC="AT" Q "TEL"
|
---|
177 | I ACKVSC="ST" Q "TEL"
|
---|
178 | Q ""
|
---|
179 | ;
|
---|
180 | DATE(Y) ; convert date portion of Y to external format
|
---|
181 | S Y=Y\1 D DD^%DT
|
---|
182 | Q Y
|
---|
183 | ;
|
---|
184 | ;
|
---|
185 | PCEVST1(ACKVD,ACKPAT,ACKCLIN) ; Checks to see if patients has a PCE visit for
|
---|
186 | ; selected clinic on visit date
|
---|
187 | ;
|
---|
188 | N ACKDATE,ACK,ACKPASS,ACKPIEN
|
---|
189 | S ACKPASS=0
|
---|
190 | S X1=ACKVD,X2="-1" D C^%DTC S X=X_".99"
|
---|
191 | F S X=$O(^AUPNVSIT("AET",ACKPAT,X)) Q:X=""!($P(X,".",1)>ACKVD)!(ACKPASS) D
|
---|
192 | . I $D(^AUPNVSIT("AET",ACKPAT,X,ACKCLIN)) S ACKPASS=1
|
---|
193 | Q ACKPASS
|
---|
194 | ;
|
---|
195 | ;
|
---|
196 | EXCEPT ; Displays Error message explaining that the visit has previously been
|
---|
197 | ; sent to PCE and that the PCE interface is now off. The changes
|
---|
198 | ; made here in Quasar will therefore not be sent to PCE thus causing
|
---|
199 | ; a data disparity between the two systems.
|
---|
200 | W !!,"WARNING"
|
---|
201 | W !!,"This visit has Previously been sent to PCE."
|
---|
202 | W !,"The edited visit will not be sent to PCE because (within the Site Parameters)"
|
---|
203 | W !,"either the INTERFACE WITH PCE field is set to off, the SEND TO PCE field for"
|
---|
204 | W !,"this Division is set to off or this visits Visit Date is before the PCE"
|
---|
205 | W !,"INTERFACE START DATE."
|
---|
206 | W !!,"Data will now be different between the Quasar and the PCE visit."
|
---|
207 | W !,"Please take the appropriate corrective action.",!
|
---|
208 | W ! K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" W ! D ^DIR
|
---|
209 | Q
|
---|