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