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

MAG7UFO.m

Go to the documentation of this file.
  1. MAG7UFO ;WOIFO/MLH - HL7 utilities - populate NEW PERSON phone(s) into an XPN field ; 12 Jun 2003 4:27 PM
  1. ;;3.0;IMAGING;**11**;14-April-2004
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. ;
  1. NPFON(XFLD,XIEN) ; FUNCTION - populate NEW PERSON phone(s) into an XPN field
  1. ;
  1. ; Input: XFLD name of array into which to populate
  1. ; (see MAG7UP for structure)
  1. ; XIEN internal entry number on ^VA(200)
  1. ;
  1. ; Expects: Fileman variables from call to DI or Kernel
  1. ;
  1. ; function return: error status (default = '0', false)
  1. ;
  1. N FGET ; --- GET return (discarded)
  1. N FEXIT ; -- exit status flag
  1. N NPFON ; -- array for return of phone numbers
  1. N IFON ; --- index for NPFON array
  1. N ILOOP ; -- loop index
  1. N PHN ; ---- the actual phone number
  1. N IREP ; --- repetition index for XFLD
  1. ;
  1. S FEXIT=0 ; default no error
  1. I $G(XFLD)="" D Q FEXIT
  1. . S FEXIT="-1;valid array not provided"
  1. . Q
  1. E I '$G(XIEN) D Q FEXIT
  1. . S FEXIT="-2;valid NEW PERSON IEN not provided"
  1. . Q
  1. D GETS^DIQ(200,XIEN,".131;.132;.133;.134;.135;.136;.137;.138","","NPFON")
  1. F ILOOP=1:1:8 D
  1. . S IFON=ILOOP/1000+.13,PHN=$G(NPFON(200,XIEN_",",IFON))
  1. . I PHN]"" D
  1. . . S IREP=$O(@XFLD@(" "),-1)+1
  1. . . S @XFLD@(IREP,1,1)=PHN
  1. . . S @XFLD@(IREP,2,1)=$P("PRN^WPN^^^^^BPN^BPN","^",ILOOP)
  1. . . S @XFLD@(IREP,3,1)=$P("PH^PH^PH^PH^PH^FX^BP^BP","^",ILOOP)
  1. . . Q
  1. . Q
  1. Q FEXIT