source: FOIAVistA/tag/r/QUASAR-ACKQ/ACKQUTL9.m@ 719

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1ACKQUTL9 ;AUG/JLTP BIR/PTD HCIOFO/BH-New Clinic Visits - CONTINUED ; [ 04/12/96 10:38 AM ]
2 ;;3.0;QUASAR;**1,4**;Feb 11, 2000
3 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 ;
5BUILD() ; Generate a message informing Supervisors that time period for
6 ; for changing Procedure code type has begun
7 ;
8 N XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X
9 S (XMDUZ,XMDUN)="QUASAR",XMTEXT="TXT(",XMSUB="A&SP Procedure Code Amendment Notice"
10 S TXT(1,0)=" "
11 S TXT(2,0)=" This notice is to inform all Quasar Supervisors that the "
12 S TXT(3,0)=" oppotunity of change the type of Procedures your Site uses"
13 S TXT(4,0)=" is now available. This option will only be available until"
14 S TXT(5,0)=" the 30th of September. If you wish to change the type of"
15 S TXT(6,0)=" Procedure codes your Site uses select Quasars Site Parameters "
16 S TXT(7,0)=" option and amend the USE EVENT CAPTURE CODES field."
17 S TXT(8,0)=" "
18 D STAFF,^XMD
19 ;
20 N ACKY
21 S ZTDESC="QUASAR - Mail Procedure code Warning"
22 D NOW^%DTC
23 S ACKY=$E(X,1,3)
24 S ACKY=ACKY+1
25 S ZTDTH=ACKY_"0917.0100"
26 S ZTIO=""
27 S ZTRTN="BUILD^ACKQUTL9()"
28 D ^%ZTLOAD
29 Q
30 ;
31CHANGE(ACKQQCH,ACKDA1) ; Passes in new changed value of USE EVENT CAPTURE CODE
32 ; field ACKQQCH will either equal '1' or zero
33 ;
34 N %X,DC,D2,DE,DH,DG,DI,DICREC,DIDATA,DIEDA,DIEFDAS,DIEFCNOD,DIEFAR
35 ; N DIENCNT,DIEFF,DIEFFLAG,DIEFFLD,DIEFFLST,DIEFFREF,DIEFFVAL,DIEFI
36 N DIEFIEN,DIFM,DIIENS,DI0V,DIP,DIEL,DITMP,DIFLD,DIEFNVAL,DIEFNODE
37 ; N DIEFLEV,DIETMP,DIEXREF,DIEFSPOT,DIEFTREF,DIEFSORK,DIEFRLST,DIEFRFLD
38 ; N DIEFOVAL
39 N DA,D,D0,D1,DIE,DIC,DR,DU,XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X,Z,Y
40 ; N DK,DQ,DP,DQI,XQZ,X1,J,M,S,POP,DV,DW,XQXFLG,XQW,XQV,XQUSER,XQSV,XQT
41 ; N XQJMP,XQCH,DOREPL,DN,DM,DLAYGO,DL,DIQUIET,DIWT,DIW,DIENS
42 N ACKDIVN S ACKDIVN=$$GET1^DIQ(40.8,ACKDA1,.01)
43 S (XMDUZ,XMDUN)="QUASAR",XMTEXT="TXT(",XMSUB="A&SP Procedure Code Change Notice."
44 S TXT(1,0)=" "
45 S TXT(2,0)=" The USE EVENT CAPTURE CODE field has been amened within "
46 S TXT(3,0)=" Quasars Site Parameters function."
47 S TXT(4,0)=" Division "_ACKDIVN_" is now set up to use "_$S(ACKQQCH=1:"Event Capture",1:"CPT")_" codes."
48 S TXT(5,0)=" This change will take effect on the 1st of October."
49 S TXT(6,0)=" "
50 D STAFF,^XMD
51 K ACKDA1
52 Q
53 ;
54STAFF ; Create XMY(... array using active supervisors from A&SP STAFF file
55 N ACKQQCNV,X,Y,ACKST,ACKIND,ACKDTE S ACKST=0
56 D NOW^%DTC ; X=TODAYS DATE
57 S ACKDTE=X
58 F S ACKST=$O(^ACK(509850.3,ACKST)) Q:'ACKST D
59 . I $P(^ACK(509850.3,ACKST,0),U,6)'=1 Q ; Not a Supervisor
60 . S ACKIND=$P(^ACK(509850.3,ACKST,0),U,4)
61 . I ACKIND'="",ACKIND<ACKDTE Q ; Inactivated
62 . S ACKQQCNV=$$CONVERT2^ACKQUTL4(ACKST) I ACKQQCNV="" Q
63 . S XMY(ACKQQCNV)=""
64 S XMY(DUZ)=""
65 I '$O(XMY(0)) S XMY(.5)=""
66 Q
67 ;
68CHECK() ; Check to see if 2 week time time window to edit USE EC CODE
69 ; is now
70 ;
71 D NOW^%DTC
72 N ACKM,ACKD
73 S ACKM=$E(X,4,5)
74 S ACKD=$E(X,6,7)
75 I ACKM'="09" Q 0
76 I ACKD>16 Q 1
77 Q 0
Note: See TracBrowser for help on using the repository browser.