78 lines
3.0 KiB
Mathematica
78 lines
3.0 KiB
Mathematica
ACKQUTL9 ;AUG/JLTP BIR/PTD HCIOFO/BH-New Clinic Visits - CONTINUED ; [ 04/12/96 10:38 AM ]
|
|
;;3.0;QUASAR;**1,4**;Feb 11, 2000
|
|
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|
;
|
|
BUILD() ; Generate a message informing Supervisors that time period for
|
|
; for changing Procedure code type has begun
|
|
;
|
|
N XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X
|
|
S (XMDUZ,XMDUN)="QUASAR",XMTEXT="TXT(",XMSUB="A&SP Procedure Code Amendment Notice"
|
|
S TXT(1,0)=" "
|
|
S TXT(2,0)=" This notice is to inform all Quasar Supervisors that the "
|
|
S TXT(3,0)=" oppotunity of change the type of Procedures your Site uses"
|
|
S TXT(4,0)=" is now available. This option will only be available until"
|
|
S TXT(5,0)=" the 30th of September. If you wish to change the type of"
|
|
S TXT(6,0)=" Procedure codes your Site uses select Quasars Site Parameters "
|
|
S TXT(7,0)=" option and amend the USE EVENT CAPTURE CODES field."
|
|
S TXT(8,0)=" "
|
|
D STAFF,^XMD
|
|
;
|
|
N ACKY
|
|
S ZTDESC="QUASAR - Mail Procedure code Warning"
|
|
D NOW^%DTC
|
|
S ACKY=$E(X,1,3)
|
|
S ACKY=ACKY+1
|
|
S ZTDTH=ACKY_"0917.0100"
|
|
S ZTIO=""
|
|
S ZTRTN="BUILD^ACKQUTL9()"
|
|
D ^%ZTLOAD
|
|
Q
|
|
;
|
|
CHANGE(ACKQQCH,ACKDA1) ; Passes in new changed value of USE EVENT CAPTURE CODE
|
|
; field ACKQQCH will either equal '1' or zero
|
|
;
|
|
N %X,DC,D2,DE,DH,DG,DI,DICREC,DIDATA,DIEDA,DIEFDAS,DIEFCNOD,DIEFAR
|
|
; N DIENCNT,DIEFF,DIEFFLAG,DIEFFLD,DIEFFLST,DIEFFREF,DIEFFVAL,DIEFI
|
|
N DIEFIEN,DIFM,DIIENS,DI0V,DIP,DIEL,DITMP,DIFLD,DIEFNVAL,DIEFNODE
|
|
; N DIEFLEV,DIETMP,DIEXREF,DIEFSPOT,DIEFTREF,DIEFSORK,DIEFRLST,DIEFRFLD
|
|
; N DIEFOVAL
|
|
N DA,D,D0,D1,DIE,DIC,DR,DU,XMDUZ,XMDUN,XMSUB,XMTEXT,XMY,TXT,X,Z,Y
|
|
; N DK,DQ,DP,DQI,XQZ,X1,J,M,S,POP,DV,DW,XQXFLG,XQW,XQV,XQUSER,XQSV,XQT
|
|
; N XQJMP,XQCH,DOREPL,DN,DM,DLAYGO,DL,DIQUIET,DIWT,DIW,DIENS
|
|
N ACKDIVN S ACKDIVN=$$GET1^DIQ(40.8,ACKDA1,.01)
|
|
S (XMDUZ,XMDUN)="QUASAR",XMTEXT="TXT(",XMSUB="A&SP Procedure Code Change Notice."
|
|
S TXT(1,0)=" "
|
|
S TXT(2,0)=" The USE EVENT CAPTURE CODE field has been amened within "
|
|
S TXT(3,0)=" Quasars Site Parameters function."
|
|
S TXT(4,0)=" Division "_ACKDIVN_" is now set up to use "_$S(ACKQQCH=1:"Event Capture",1:"CPT")_" codes."
|
|
S TXT(5,0)=" This change will take effect on the 1st of October."
|
|
S TXT(6,0)=" "
|
|
D STAFF,^XMD
|
|
K ACKDA1
|
|
Q
|
|
;
|
|
STAFF ; Create XMY(... array using active supervisors from A&SP STAFF file
|
|
N ACKQQCNV,X,Y,ACKST,ACKIND,ACKDTE S ACKST=0
|
|
D NOW^%DTC ; X=TODAYS DATE
|
|
S ACKDTE=X
|
|
F S ACKST=$O(^ACK(509850.3,ACKST)) Q:'ACKST D
|
|
. I $P(^ACK(509850.3,ACKST,0),U,6)'=1 Q ; Not a Supervisor
|
|
. S ACKIND=$P(^ACK(509850.3,ACKST,0),U,4)
|
|
. I ACKIND'="",ACKIND<ACKDTE Q ; Inactivated
|
|
. S ACKQQCNV=$$CONVERT2^ACKQUTL4(ACKST) I ACKQQCNV="" Q
|
|
. S XMY(ACKQQCNV)=""
|
|
S XMY(DUZ)=""
|
|
I '$O(XMY(0)) S XMY(.5)=""
|
|
Q
|
|
;
|
|
CHECK() ; Check to see if 2 week time time window to edit USE EC CODE
|
|
; is now
|
|
;
|
|
D NOW^%DTC
|
|
N ACKM,ACKD
|
|
S ACKM=$E(X,4,5)
|
|
S ACKD=$E(X,6,7)
|
|
I ACKM'="09" Q 0
|
|
I ACKD>16 Q 1
|
|
Q 0
|