Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACKQUTL9

ACKQUTL9.m

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