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

ACKQUTL1.m

Go to the documentation of this file.
  1. ACKQUTL1 ;HCIOFO/BH-Utilities ; [ 04/12/96 10:38 AM ]
  1. ;;3.0;QUASAR;**1**;Feb 11, 2000
  1. ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
  1. ;
  1. EVENT(ACKDIV) ; It has to be between 17th and 30th of september to use this option
  1. I '$$CHECK^ACKQUTL9() Q
  1. N DIR,Y,ACKEC,ACKY,ACKKEY,X
  1. ; DISPLAY WARNING HERE
  1. ;
  1. ; Give user option to quit
  1. W !!!
  1. W "Warning - The following field allows Supervisors to amend the type of Procedure"
  1. W !," codes used within a particular Division for the coming DSS extract"
  1. W !," period. This option is only made available between the 17th & 30th"
  1. W !," of September each year. Users will be able to re-edit this"
  1. W !," field within this time period but all values after the 30th of"
  1. W !," September will be final for the approaching Fiscal Year !"
  1. W !!!
  1. S DIR(0)="Y"
  1. S DIR("?")="Enter 'Yes' if you wish to continue or 'No' to Quit."
  1. S DIR("A")="Do you wish to continue."
  1. S DIR("B")="NO" W ! D ^DIR K DIR
  1. I Y=0 Q
  1. ;
  1. N ACKPRAM S ACKPRAM=""
  1. D NOW^%DTC
  1. S ACKY=$E(X,2,3) S ACKY=ACKY+1 I $L(ACKY)=1 S ACKY="0"_ACKY
  1. I '$D(^ACK(509850.8,1,2,ACKDIV,2,"B",ACKY)) D
  1. . N ACKARR1,ACKCIEN S ACKCIEN="",ACKPRAM="INIT"
  1. . S ACKARR1(509850.832,"+1,"_ACKDIV_",1,",.01)=ACKY
  1. . ; S ACKARR1(509850.832,"+1,"_ACKDIV_",1,",2)="0"
  1. . D UPDATE^DIE("","ACKARR1","ACKCIEN","ERR")
  1. . ;
  1. S ACKKEY=0
  1. S ACKKEY=$O(^ACK(509850.8,1,2,ACKDIV,2,"B",ACKY,ACKKEY))
  1. S ACKEC=$P(^ACK(509850.8,1,2,ACKDIV,2,ACKKEY,0),"^",2)
  1. I ACKEC="" S ACKEC="0"
  1. ;
  1. W !!
  1. S DIR(0)="Y"
  1. 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."
  1. S DIR("A")="USE EVENT CAPTURE CODES"
  1. S DIR("B")="NO" I ACKEC=1 S DIR("B")="YES"
  1. D ^DIR K DIR
  1. I Y'=ACKEC!(ACKPRAM="INIT") D
  1. . N ACKARR
  1. . S ACKARR(509850.832,ACKKEY_","_ACKDIV_",1,",2)=Y D FILE^DIE("","ACKARR",)
  1. . ; S $P(^ACK(509850.8,1,2,ACKDIV,2,ACKKEY,0),"^",2)=Y
  1. W !!
  1. Q
  1. ;