source: WorldVistAEHR/trunk/r/QUASAR-ACKQ/ACKQUTL1.m@ 1259

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1ACKQUTL1 ;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 ;
5EVENT(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 ;
Note: See TracBrowser for help on using the repository browser.