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