source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAG7UFO.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1MAG7UFO ;WOIFO/MLH - HL7 utilities - populate NEW PERSON phone(s) into an XPN field ; 12 Jun 2003 4:27 PM
2 ;;3.0;IMAGING;**11**;14-April-2004
3 ;; +---------------------------------------------------------------+
4 ;; | Property of the US Government. |
5 ;; | No permission to copy or redistribute this software is given. |
6 ;; | Use of unreleased versions of this software requires the user |
7 ;; | to execute a written test agreement with the VistA Imaging |
8 ;; | Development Office of the Department of Veterans Affairs, |
9 ;; | telephone (301) 734-0100. |
10 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19 ;
20NPFON(XFLD,XIEN) ; FUNCTION - populate NEW PERSON phone(s) into an XPN field
21 ;
22 ; Input: XFLD name of array into which to populate
23 ; (see MAG7UP for structure)
24 ; XIEN internal entry number on ^VA(200)
25 ;
26 ; Expects: Fileman variables from call to DI or Kernel
27 ;
28 ; function return: error status (default = '0', false)
29 ;
30 N FGET ; --- GET return (discarded)
31 N FEXIT ; -- exit status flag
32 N NPFON ; -- array for return of phone numbers
33 N IFON ; --- index for NPFON array
34 N ILOOP ; -- loop index
35 N PHN ; ---- the actual phone number
36 N IREP ; --- repetition index for XFLD
37 ;
38 S FEXIT=0 ; default no error
39 I $G(XFLD)="" D Q FEXIT
40 . S FEXIT="-1;valid array not provided"
41 . Q
42 E I '$G(XIEN) D Q FEXIT
43 . S FEXIT="-2;valid NEW PERSON IEN not provided"
44 . Q
45 D GETS^DIQ(200,XIEN,".131;.132;.133;.134;.135;.136;.137;.138","","NPFON")
46 F ILOOP=1:1:8 D
47 . S IFON=ILOOP/1000+.13,PHN=$G(NPFON(200,XIEN_",",IFON))
48 . I PHN]"" D
49 . . S IREP=$O(@XFLD@(" "),-1)+1
50 . . S @XFLD@(IREP,1,1)=PHN
51 . . S @XFLD@(IREP,2,1)=$P("PRN^WPN^^^^^BPN^BPN","^",ILOOP)
52 . . S @XFLD@(IREP,3,1)=$P("PH^PH^PH^PH^PH^FX^BP^BP","^",ILOOP)
53 . . Q
54 . Q
55 Q FEXIT
Note: See TracBrowser for help on using the repository browser.