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

VAFCCRNR.m

Go to the documentation of this file.
  1. VAFCCRNR ;BIR/JFW-VAFC EHRM MIGRATED FACILITIES FILE (#391.919) Utilities ;2/22/22 13:55
  1. ;;5.3;Registration;**981,1050,1071**;Aug 13, 1993;Build 4
  1. ;
  1. ;Story 961754 (jfw) - Support processes where there is a need to know
  1. ; which facilities have migrated to CERNER.
  1. ;DBIA: $$IEN^XUAF4 : Supported - #2171
  1. Q
  1. ;
  1. ;Input: VAFCARY - Array of Station #'s migrated to CERNER (*Required by Ref.)
  1. ; ie. VAFCARY(<Station#>)=""
  1. ; VAFCRTN - 1 upon processing completed (*Required by Ref.)
  1. ; Additional Error Info - VAFCRTN(<#>)=Station# ^ Error Code ^ Error Message
  1. UPDT(VAFCARY,VAFCRTN) ;Add/Update EHRM MIGRATED FACILITIES (#391.919) records
  1. N VAFCSN,VAFCSITE,VAFCRSLT
  1. ;Remove CERNER ENABLED? Flag if site is no longer using the application
  1. S VAFCSN=0 F S VAFCSN=$O(^DGCN(391.919,"ACRNR",VAFCSN)) Q:'+VAFCSN D
  1. .D:('($D(VAFCARY(VAFCSN))))
  1. ..S VAFCRSLT=$$OFFCRNR($$IEN^XUAF4(VAFCSN))
  1. ..S:(VAFCRSLT'=1) VAFCRTN(VAFCSN)=VAFCRSLT
  1. ;Add/Update Facility entries that have migrated to CERNER if applicable
  1. S VAFCSN=0 F S VAFCSN=$O(VAFCARY(VAFCSN)) Q:'+VAFCSN D
  1. .D:('($D(^DGCN(391.919,"ACRNR",VAFCSN))))
  1. ..S VAFCRSLT=$$ONCRNR($$IEN^XUAF4(VAFCSN))
  1. ..S:(VAFCRSLT'=1) VAFCRTN(VAFCSN)=VAFCSN_"^"_VAFCRSLT
  1. S VAFCRTN=1
  1. Q
  1. ;
  1. ;Input: VAFCSIEN - IEN of the Facility to Add/Update
  1. ;Output: 1 if Successful or ErrorCode ^ Error Message
  1. ONCRNR(VAFCSIEN) ;Update EHRM MIGRATED FACILITIES (#391.919) entry to show site migrated to CERNER
  1. N VAFCFDA,VAFCEMSG,VAFCEXST,VAFCFIEN
  1. Q:(VAFCSIEN="") "^IEN for Station Number is NOT known!"
  1. S VAFCEXST=$D(^DGCN(391.919,"B",VAFCSIEN))
  1. ;Add new facility entry to the file
  1. D:('VAFCEXST)
  1. .S VAFCFDA(391.919,"+1,",.01)=VAFCSIEN
  1. .S VAFCFDA(391.919,"+1,",.02)=1
  1. .S VAFCFIEN(1)=VAFCSIEN ;.01 is DINUMED to Site IEN.
  1. .D UPDATE^DIE("","VAFCFDA","VAFCFIEN","VAFCEMSG")
  1. ;Updating existing facility entry in the file
  1. D:(VAFCEXST)
  1. .S VAFCFDA(391.919,VAFCSIEN_",",.02)=1
  1. .D FILE^DIE("K","VAFCFDA","VAFCEMSG")
  1. Q $S('$D(VAFCEMSG):1,1:$G(VAFCEMSG("DIERR",1))_"^"_$G(VAFCEMSG("DIERR",1,"TEXT",1)))
  1. ;
  1. ;Input: VAFCSIEN - IEN of the Facility to Update
  1. ;Output: 1 if Successful or ErrorCode ^ Error Message
  1. OFFCRNR(VAFCSIEN) ;Set CERNER ENABLED? field to NO for Site
  1. N VAFCFDA,VAFCEMSG
  1. Q:(VAFCSIEN="") "^IEN for Station Number is NOT known!"
  1. S VAFCFDA(391.919,VAFCSIEN_",",.02)=0
  1. D FILE^DIE("K","VAFCFDA","VAFCEMSG")
  1. Q $S('$D(VAFCEMSG):1,1:$G(VAFCEMSG("DIERR",1))_"^"_$G(VAFCEMSG("DIERR",1,"TEXT",1)))
  1. ;
  1. CRNRSITE(VAFCSTNUM) ;is site cerner enabled ;**1050, VAMPI-10038 (dri)
  1. ;Input:
  1. ; VAFCSTNUM - station number to check
  1. ;
  1. ;Output;
  1. ; 0 - not cerner enabled
  1. ; 1 - cerner enabled
  1. ;
  1. I $G(VAFCSTNUM)'="",$O(^DGCN(391.919,"ACRNR",VAFCSTNUM,0)) Q 1
  1. Q 0
  1. ;
  1. GCRNSITE() ;Return the CERNER Station Number configured for this VistA Instance
  1. ;**1071 VAMPI-13671 (dri) new api for VistA consumers needed due to cerner cert/mock accounts
  1. N CRNIEN,CRNSITE
  1. S CRNIEN=$O(^MPIF(984.8,"B","FOUR",0)) I CRNIEN S CRNSITE=$P($G(^MPIF(984.8,CRNIEN,0)),"^",5)
  1. I $G(CRNSITE)="" S CRNSITE="200CRNR"
  1. Q CRNSITE
  1. ;
  1. ISCRNPAT(DGDFN) ;Is this a Cerner patient (i.e., is 200CRNR in the TFL)?
  1. ;**1071 VAMPI-13671 (dri) new api for VistA consumers needed due to cerner cert/mock accounts
  1. ;Input:
  1. ; DGDFN - pointer to PATIENT (#2) file
  1. ;
  1. ;Return:
  1. ; 1 - yes, 0 - no
  1. ;
  1. N DGRES,DGOUT,DGSITE,DGKEY,DGI
  1. S DGRES=0
  1. S DGSITE=$P($$SITE^VASITE,U,3)
  1. S DGKEY=DGDFN_U_"PI"_U_"USVHA"_U_DGSITE
  1. D TFL^VAFCTFU2(.DGOUT,DGKEY)
  1. S DGI=0 F S DGI=$O(DGOUT(DGI)) Q:DGI="" I $P(DGOUT(DGI),U,4)=$$GCRNSITE(),$P(DGOUT(DGI),U,2)="PI" S DGRES=1 Q
  1. Q DGRES
  1. ;