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

AVA200E.m

Go to the documentation of this file.
  1. AVA200E ;IHS/OIT/FBD - EPCS-SPECIFIC PROVIDER EDIT SUBROUTINES
  1. ;;93.2;VA SUPPORT FILES;**24**;SEP 30, 2010;Build 6
  1. ;PATCH #24: Conditionalized DEA-related field edits in Add Provider - EPCS CR 09865 - IHS/OIT/FBD
  1. ;
  1. Q
  1. ;
  1. EPCSEDIT(AVADA) ;DETERMINE IF EDIT OF DEA# AND DEA EXPIRATION DATE FIELDS SHOULD BE PERMITTED
  1. ;AVADA = PROVIDER RECORD IEN IN FILE 200
  1. ;
  1. N DA,DIE,DR,EPCSTAT,PROVIDER
  1. S EPCSTAT=0
  1. I +AVADA D ;PROCEED IF VALID FILE 200 ENTRY SELECTED
  1. . S PROVIDER=+AVADA
  1. . I $$CHKPATCH("OR*3.0*1017") D ;OR*3.0*1017 PATCH PRESENCE INDICATES EPCS HAS BEEN INSTALLED
  1. . . D PKIUSE^ORWOR(.EPCSTAT,PROVIDER) ;IF SO, CHECK IF PROVIDER IS EPCS-ENABLED
  1. . . I 'EPCSTAT D ;IF PROVIDER IS _NOT_ EPCS-ENABLED...
  1. . . . D DEAEDIT(PROVIDER) ;...ALLOW DIRECT EDIT OF PROVIDER'S DEA-RELATED FIELDS
  1. . . . I 1
  1. . E D ;IF EPCS HAS NOT BEEN INSTALLED...
  1. . . D DEAEDIT(PROVIDER) ;...ALLOW THE DIRECT EDIT OF DEA-RELATED FIELDS
  1. . . I 1
  1. Q
  1. ;
  1. DEAEDIT(PROV) ;EDIT DEA-RELATED FIELDS FOR A PROVIDER
  1. N DA,DIE,DR
  1. S DIE=200,DA=PROV
  1. ;S DR="53.2;747.44" ;DEA#, DEA EXPIRATION DATE
  1. ;S DR=DR_";53.11;53.3;55.1;55.2;55.3;55.4;55.5;55.6" ;DETOX/MAINTENANCE ID NUMBER, VA#, SCHEDULE II NARCOTIC, SCHEDULE II NON-NARCOTIC, SCHEDULE III NARCOTIC, SCHEDULE III NON-NARCOTIC, SCHEDULE IV, SCHEDULE V
  1. S DR="[AVA EPCS DEA EDIT]" ;SAME FIELD EDITS AS SPECIFIED IN ABOVE COMMENTS, W/REPLACEMENT "DEA X" DISPLAY LABEL FOR 53.11
  1. D ^DIE
  1. Q
  1. ;
  1. CHKPATCH(X) ;CHECK IF A SPECIFIC PATCH HAS BEEN INSTALLED
  1. ; RETURNS 1 IF PATCH HAS BEEN INSTALLED, 0 IF NOT
  1. ;
  1. N XPDA,OK
  1. S OK=0
  1. S XPDA=0
  1. F S XPDA=$O(^XPD(9.7,"B",X,XPDA)) Q:'XPDA D
  1. . I $P($G(^XPD(9.7,XPDA,0)),U,9)=3 S OK=1
  1. ;S AVAMSG=$S(OK'=1:"Missing <<<--- FIX IT!",1:"Present.")
  1. ;W !,$$CJ^XLFSTR("Need patch "_X_"....."_AVAMSG,IOM)
  1. Q OK