| 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 | ;
|
|---|
