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

BPSJINIT.m

Go to the documentation of this file. 
  1. BPSJINIT ;BHAM ISC/LJF - HL7 Application Registration ;03/07/08  14:09
  1.  ;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5,7**;JUN 2004;Build 46
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  N DA,DIC,DIE,DINUM,DIR,DIRUT,DIROUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
  1.  N BPSJAPPR,BPSJVALR,PHIX,BPSOUT
  1.  ;
  1.  ;  This program will allow user to enter site data.
  1.  ;
  1.  ; Programmer Note: D BPSJVAL^BPSJAREG(X) will validate with following.
  1.  ;   where X is: 0 = HL7 trigger, no validation display
  1.  ;               1 = HL7 trigger, display validation
  1.  ;               2 = no HL7 trigger, display validation
  1.  ;               3 = no validation display, no HL7 trigger
  1.  ;
  1.  W !!,?IOM/2-14,"** ECME Site Registration **"
  1.  ;
  1.  ; Create/update BPS Setup record
  1.  D VERSION
  1.  ;
  1.  S BPSOUT=0
  1.  S DIE="^BPS(9002313.99,",DA=1
  1.  S DR="[BPSJ SITE SETUP]" D ^DIE
  1.  I BPSOUT!($D(Y)) Q
  1.  ;
  1.  W !!!,"-- Application Registration Validation Results:"
  1.  S BPSJVALR=-1
  1.  D BPSJVAL^BPSJAREG(2)
  1.  S BPSJAPPR=BPSJVALR
  1.  ;
  1.  I 'BPSJAPPR W !!,?IOM/2-21,"** Application Registration Data VALID **",!
  1.  E  D
  1.  . W !!,"** Application Registration Data INVALID!!!  **"
  1.  . W !,"**  Application Registration and Pharmacy    **"
  1.  . W !,"**    Registrations will NOT be sent!        **",!
  1.  ;
  1.  S DIR(0)="EO" D ^DIR I X=U Q
  1.  ;
  1.  D PHARM(.BPSOUT)
  1.  I BPSOUT Q
  1.  I BPSJAPPR D  Q
  1.  . W !!,"Registration ABORTED due to invalid site registration data",!!
  1.  ;
  1.  W !!!,"Application Registration Data is VALID"
  1.  W !!,"Pharmacy Registration Data is:"
  1.  S PHIX=$O(^BPS(9002313.56,0))
  1.  F  Q:'PHIX  D  S PHIX=$O(^BPS(9002313.56,PHIX))
  1.  . S BPSJVALR=-1 D REG^BPSJPREG(PHIX,3)
  1.  . I BPSJVALR>0 S DIR=" *INVALID",DIE=" and will NOT be transmitted."
  1.  . E  S DIR="    VALID",DIE=" and will be transmitted."
  1.  . W !,DIR_" for "_$P($G(^BPS(9002313.56,PHIX,0)),U)_DIE
  1.  W !
  1.  K DA,DIC,DIE,DINUM,DIR,DIRUT,DIROUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="YEO",DIR("A")="Send Application Registration: Y/N " D ^DIR
  1.  I $TR($E(X),"y","Y")'="Y" Q
  1.  ;
  1.  K DA,DIC,DIE,DINUM,DIR,DIRUT,DIROUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
  1.  D BPSJVAL^BPSJAREG(0)
  1.  W !!,"Application Registration SUBMITTED..."
  1.  Q
  1.  ;
  1. PHARM(BPSOUT) ;CYCLE THROUGH PHARMACIES
  1.  ;
  1.  N DA,DIC,DIE,DINUM,DIR,DIRUT,DIROUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
  1.  N BPSJVALR,BPSJPHPR,BPSPHARM
  1.  ;
  1.  S BPSPHARM=0 F  D  Q:BPSPHARM=""!(BPSOUT)
  1.  . W !!!,"Enter/verify Pharmacy Registration Data"
  1.  . ;
  1.  . ;check for drop dead date
  1.  . S DIC(0)="QAELM"
  1.  . S DIC="^BPS(9002313.56,",DLAYGO=DIC D ^DIC
  1.  . ;
  1.  . I X'=U,0<+Y S BPSPHARM=+Y
  1.  . E  S BPSPHARM="" Q
  1.  . D MOD(BPSPHARM,.BPSOUT) I 'BPSPHARM!(BPSOUT) Q
  1.  . W !!!,"-- Pharmacy Registration Validation Results --",!
  1.  . ;
  1.  . S BPSJVALR=-1
  1.  . D REG^BPSJPREG(BPSPHARM,2)
  1.  . S BPSJPHPR=BPSJVALR
  1.  . ;
  1.  . I 'BPSJPHPR W !!,"-- Pharmacy Registration Data VALID. --",!
  1.  . E  D
  1.  .. W !!,"**     Pharmacy Registration Data INVALID!!!      **"
  1.  .. W !,"** This pharmacy's registration will NOT be sent! **",!
  1.  ;
  1.  Q
  1.  ;
  1. MOD(DA,BPSOUT) ;
  1.  N DIE,DR,DTOUT,X,Y
  1.  ;
  1.  ; Set STATUS default to ACTIVE if not set
  1.  I $P($G(^BPS(9002313.56,DA,0)),"^",10)="" D
  1.  . S DR=".1///ACTIVE",DIE="^BPS(9002313.56,"
  1.  . D ^DIE
  1.  ;
  1.  S DIE="^BPS(9002313.56,"
  1.  S DR="[BPSJ PHARMACY ENTER/EDIT]" D ^DIE
  1.  I $D(Y) S BPSOUT=1
  1.  ;
  1.  Q
  1.  ;
  1. VERSION ;
  1.  ; Create entry if missing
  1.  ; Sets in defaults:
  1.  ;    ECME TIMEOUT: 10
  1.  ;    SITE TYPE: VA
  1.  ;    WINNOW TESTING FLAG: NO
  1.  ;    VA LAST SEQUENCE: = $P($P($G(^BPSC(+$P(^BPSC(0),U,3),0)),U),?=?,4)
  1.  ;    WINNOW BPS LOG: 36
  1.  ;    VITRIA INTERFACE VERSION: 3
  1.  ;
  1.  N BPSDA,DIC,DLAYGO,X,Y,DTOUT,DUOUT,DINUM
  1.  S BPSDA=$O(^BPS(9002313.99,0))
  1.  I BPSDA'=1 D
  1.  . S (DIC,DLAYGO)=9002313.99,DIC(0)="L",X="MAIN SETUP ENTRY",DINUM=1
  1.  . S DIC("DR")="3.01///10;1000///^S X=$P($P($G(^BPSC(+$P(^BPSC(0),U,3),0)),U),"=",4);9999///VA;6003///3;2341.01///NO;2341.03///36"
  1.  . D ^DIC
  1.  ;
  1.  Q
  1.  ;