1 | ACKQUTL1 ;HCIOFO/BH-Utilities ; [ 04/12/96 10:38 AM ]
|
---|
2 | ;;3.0;QUASAR;**1**;Feb 11, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
---|
4 | ;
|
---|
5 | EVENT(ACKDIV) ; It has to be between 17th and 30th of september to use this option
|
---|
6 | I '$$CHECK^ACKQUTL9() Q
|
---|
7 | N DIR,Y,ACKEC,ACKY,ACKKEY,X
|
---|
8 | ; DISPLAY WARNING HERE
|
---|
9 | ;
|
---|
10 | ; Give user option to quit
|
---|
11 | W !!!
|
---|
12 | W "Warning - The following field allows Supervisors to amend the type of Procedure"
|
---|
13 | W !," codes used within a particular Division for the coming DSS extract"
|
---|
14 | W !," period. This option is only made available between the 17th & 30th"
|
---|
15 | W !," of September each year. Users will be able to re-edit this"
|
---|
16 | W !," field within this time period but all values after the 30th of"
|
---|
17 | W !," September will be final for the approaching Fiscal Year !"
|
---|
18 | W !!!
|
---|
19 | S DIR(0)="Y"
|
---|
20 | S DIR("?")="Enter 'Yes' if you wish to continue or 'No' to Quit."
|
---|
21 | S DIR("A")="Do you wish to continue."
|
---|
22 | S DIR("B")="NO" W ! D ^DIR K DIR
|
---|
23 | I Y=0 Q
|
---|
24 | ;
|
---|
25 | N ACKPRAM S ACKPRAM=""
|
---|
26 | D NOW^%DTC
|
---|
27 | S ACKY=$E(X,2,3) S ACKY=ACKY+1 I $L(ACKY)=1 S ACKY="0"_ACKY
|
---|
28 | I '$D(^ACK(509850.8,1,2,ACKDIV,2,"B",ACKY)) D
|
---|
29 | . N ACKARR1,ACKCIEN S ACKCIEN="",ACKPRAM="INIT"
|
---|
30 | . S ACKARR1(509850.832,"+1,"_ACKDIV_",1,",.01)=ACKY
|
---|
31 | . ; S ACKARR1(509850.832,"+1,"_ACKDIV_",1,",2)="0"
|
---|
32 | . D UPDATE^DIE("","ACKARR1","ACKCIEN","ERR")
|
---|
33 | . ;
|
---|
34 | S ACKKEY=0
|
---|
35 | S ACKKEY=$O(^ACK(509850.8,1,2,ACKDIV,2,"B",ACKY,ACKKEY))
|
---|
36 | S ACKEC=$P(^ACK(509850.8,1,2,ACKDIV,2,ACKKEY,0),"^",2)
|
---|
37 | I ACKEC="" S ACKEC="0"
|
---|
38 | ;
|
---|
39 | W !!
|
---|
40 | S DIR(0)="Y"
|
---|
41 | S DIR("?")="Answer 'YES' if you want this Division to use Event Capture codes or 'No' if you want this Division to use CPT codes."
|
---|
42 | S DIR("A")="USE EVENT CAPTURE CODES"
|
---|
43 | S DIR("B")="NO" I ACKEC=1 S DIR("B")="YES"
|
---|
44 | D ^DIR K DIR
|
---|
45 | I Y'=ACKEC!(ACKPRAM="INIT") D
|
---|
46 | . N ACKARR
|
---|
47 | . S ACKARR(509850.832,ACKKEY_","_ACKDIV_",1,",2)=Y D FILE^DIE("","ACKARR",)
|
---|
48 | . ; S $P(^ACK(509850.8,1,2,ACKDIV,2,ACKKEY,0),"^",2)=Y
|
---|
49 | W !!
|
---|
50 | Q
|
---|
51 | ;
|
---|