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

IBCNRE2.m

Go to the documentation of this file. 
  1. IBCNRE2 ;DAOU/DMK - Edit NCPDP PROCESSOR APPLICATION Sub-file ;23-DEC-2003
  1.  ;;2.0;INTEGRATED BILLING;**251,550**;21-MAR-94;Build 25
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Specific to E-PHARM APPLICATION Entry
  1.  ; Edit LOCAL ACTIVE? Field
  1.  ;
  1.  ; 366.013 NCPDP PROCESSOR APPLICATION
  1.  ;    .01  APPLICATION
  1.  ;    .03  LOCAL ACTIVE?
  1.  ;
  1. 1000 ; Control processing
  1.  N ANAME,APIEN,FIELDNO,FILENO,FILENO1,QUIT
  1.  N DISYS
  1.  ;
  1.  D INIT1
  1.  D HEADING
  1.  F  D 2000 Q:QUIT
  1.  Q
  1.  ;
  1. 2000 ; Control processing
  1.  N IEN,IENS,IENS1,KEY
  1.  ;
  1.  S QUIT=0
  1.  ;
  1.  ; Control file entry selection and subfile entry validation
  1.  D IEN
  1.  I IEN=-1 S QUIT=1 Q
  1.  I APIEN=-1 Q
  1.  ;
  1.  ; Control file entry printing
  1.  D PRINT1
  1.  ;
  1.  ; Control subfile entry printing
  1.  D PRINT2
  1.  ;
  1.  ; Control subfile entry editing
  1.  D EDIT
  1.  Q
  1.  ;
  1. EDIT ; Edit subfile entry data
  1.  ; 366.013 NCPDP PROCESSOR APPLICATION subfile
  1.  ;
  1.  N DA,DIDEL,DIC,DIE,DLAYGO,DR,DTOUT,X,Y
  1.  N %,A,D,D0,DDER,DI,DISYS,DQ,OLD
  1.  ;
  1.  S DA=APIEN,DA(1)=IEN
  1.  S DIE=$$ROOT^DILFD(FILENO1,","_IEN_",")
  1.  ;
  1.  ; .03  LOCAL ACTIVE
  1.  S DR=".03R"_"~"_KEY_" - Local Active?"
  1.  ;
  1.  ; Quit if value unchanged
  1.  ; OLD = old value
  1.  ;   X = new value
  1.  S OLD=$$GET1^DIQ(FILENO1,IENS1,.03,"I")
  1.  S DR=DR_";"_"S:OLD=X Y="""""
  1.  ;
  1.  ; .04  USER EDITED LOCAL
  1.  S DR=DR_";"_".04////"_DUZ
  1.  ;
  1.  ; .05  DATE/TIME LOCAL EDITED
  1.  S DR=DR_";"_".05////"_$$NOW^XLFDT()
  1.  ;
  1.  D ^DIE
  1.  ;
  1.  W !
  1.  Q
  1.  ;
  1. HEADING ; Print heading
  1.  W @IOF
  1.  W "NCPDP PROCESSOR File Inquiry and Edit (E-PHARM)",!
  1.  Q
  1.  ;
  1. IEN ; Select file entry
  1.  N I
  1.  ;
  1.  S IEN=$$SELECT1^IBCNRFM1(FILENO,"Select NCPDP Processor Name: ")
  1.  I IEN=-1 Q
  1.  S IENS=IEN_","
  1.  ;
  1.  ; E-PHARM APPLICATION Defined?
  1.  S APIEN=$$LOOKUP2^IBCNRFM1(FILENO,IEN,FIELDNO,ANAME)
  1.  I APIEN=-1 W " E-PHARM APPLICATION not defined" Q
  1.  S IENS1=APIEN_","_IEN_","
  1.  Q
  1.  ;
  1. INIT1 ; Initialize variables
  1.  S ANAME="E-PHARM"
  1.  S FIELDNO=3
  1.  S FILENO=366.01
  1.  S FILENO1=FILENO_FIELDNO
  1.  I '$D(IOF) D HOME^%ZIS
  1.  Q
  1.  ;
  1. PRINT1 ; Print file entry data
  1.  ; 366.01 NCPDP PROCESSOR File
  1.  ;
  1.  N A
  1.  ;
  1.  W !!
  1.  ;
  1.  D GETS^DIQ(FILENO,IENS,"*","","A")
  1.  ;
  1.  ; .01 NAME
  1.  S KEY=A(FILENO,IENS,.01)
  1.  W $J("NCPDP Processor Name: ",40),$G(A(FILENO,IENS,.01)),!
  1.  ;
  1.  ; .03 DATE/TIME CREATED
  1.  W $J("Date/Time Created: ",40),$G(A(FILENO,IENS,.03)),!
  1.  ;
  1.  ; .02 BLOCKED?
  1.  W $J("Blocked? ",40),$G(A(FILENO,IENS,.02)),!
  1.  Q
  1.  ;
  1. PRINT2 ; Print subfile entry data
  1.  ; 366.013 NCPDP PROCESSOR APPLICATION Subfile
  1.  ;
  1.  N A
  1.  ;
  1.  W !
  1.  ;
  1.  D GETS^DIQ(FILENO1,IENS1,"*","","A")
  1.  ;
  1.  ; .01 APPLICATION
  1.  W $J("Application: ",40),$G(A(FILENO1,IENS1,.01)),!
  1.  ;
  1.  ; .13 DATE/TIME CREATED
  1.  W $J("Date/Time Created: ",40),$G(A(FILENO1,IENS1,.13)),!
  1.  ;
  1.  ; .11 DEACTIVATED
  1.  W $J("Deactivated? ",40),$G(A(FILENO1,IENS1,.11)),!
  1.  ;
  1.  ; .12 DATE/TIME DEACTIVATED
  1.  W $J("Date/Time Deactivated: ",40),$G(A(FILENO1,IENS1,.12)),!
  1.  ;
  1.  ; .02 NATIONAL ACTIVE
  1.  W $J("National Active? ",40),$G(A(FILENO1,IENS1,.02)),!
  1.  ;
  1.  ; .06 DATE/TIME NATIONAL EDITED
  1.  W $J("Date/Time National Edited: ",40),$G(A(FILENO1,IENS1,.06)),!
  1.  ;
  1.  ; .03 LOCAL ACTIVE
  1.  W $J("Local Active? ",40),$G(A(FILENO1,IENS1,.03)),!
  1.  ;
  1.  ; .05 DATE/TIME LOCAL EDITED
  1.  W $J("Date/Time Local Edited: ",40),$G(A(FILENO1,IENS1,.05)),!
  1.  ;
  1.  ; .04 USER EDITED LOCAL
  1.  W $J("User Edited Local: ",40),$G(A(FILENO1,IENS1,.04)),!
  1.  Q