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

PXAIUPRV.m

Go to the documentation of this file.
  1. PXAIUPRV ;ISL/JVS - VALIDATE THE PAROVDER NODES ;6/6/96 07:42
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
  1. Q
  1. ;
  1. 01(IEN) ;
  1. I '$D(^VA(200,+IEN,0)) S PXCA("ERROR","PROVIDER",IEN,0,0)="Provider not in File 200^"_IEN,PXAIVAL=1
  1. ;E I '$D(^VA(200,"AK.PROVIDER",$P($G(^VA(200,+IEN,0)),"^"))) S PXCA("ERROR","PROVIDER",IEN,0,0)="Provider does not have the AK.PROVIDER key^"_IEN,PXAIVAL=2
  1. Q
  1. ;
  1. 04(IEN,PRIMARY) ;
  1. I '(PRIMARY="P"!(PRIMARY="S")) S PXCA("ERROR","PROVIDER",IEN,0,1)="Provider indicator code must be P|S^"_PRIMARY,PXAIVAL=1
  1. ;If there is more than one primary the change additional ones to secondary.
  1. I PRIMARY="P" D
  1. . I 'PXCAPPRV S PXCAPPRV=IEN
  1. . E I PXCAPPRV'=IEN D
  1. .. S PXCA("WARNING","PROVIDER",IEN,0,1)="There is already a Primary Provider this one is changed to Secondary^"_PRIMARY
  1. .. S $P(PXCAPRV,"^",1)="S"
  1. Q
  1. ;
  1. 05(ATTEND) ;
  1. I '(ATTEND=1!(ATTEND=0)!(ATTEND="")) S PXCA("ERROR","PROVIDER",IEN,0,2)="Attending flag bad^"_ATTEND,PXAIVAL=1
  1. Q
  1. ;