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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAG7UFO 2380 printed Dec 13, 2024@01:59:23 Page 2
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
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
NPFON(XFLD,XIEN) ; FUNCTION - populate NEW PERSON phone(s) into an XPN field
+1 ;
+2 ; Input: XFLD name of array into which to populate
+3 ; (see MAG7UP for structure)
+4 ; XIEN internal entry number on ^VA(200)
+5 ;
+6 ; Expects: Fileman variables from call to DI or Kernel
+7 ;
+8 ; function return: error status (default = '0', false)
+9 ;
+10 ; --- GET return (discarded)
NEW FGET
+11 ; -- exit status flag
NEW FEXIT
+12 ; -- array for return of phone numbers
NEW NPFON
+13 ; --- index for NPFON array
NEW IFON
+14 ; -- loop index
NEW ILOOP
+15 ; ---- the actual phone number
NEW PHN
+16 ; --- repetition index for XFLD
NEW IREP
+17 ;
+18 ; default no error
SET FEXIT=0
+19 IF $GET(XFLD)=""
Begin DoDot:1
+20 SET FEXIT="-1;valid array not provided"
+21 QUIT
End DoDot:1
QUIT FEXIT
+22 IF '$TEST
IF '$GET(XIEN)
Begin DoDot:1
+23 SET FEXIT="-2;valid NEW PERSON IEN not provided"
+24 QUIT
End DoDot:1
QUIT FEXIT
+25 DO GETS^DIQ(200,XIEN,".131;.132;.133;.134;.135;.136;.137;.138","","NPFON")
+26 FOR ILOOP=1:1:8
Begin DoDot:1
+27 SET IFON=ILOOP/1000+.13
SET PHN=$GET(NPFON(200,XIEN_",",IFON))
+28 IF PHN]""
Begin DoDot:2
+29 SET IREP=$ORDER(@XFLD@(" "),-1)+1
+30 SET @XFLD@(IREP,1,1)=PHN
+31 SET @XFLD@(IREP,2,1)=$PIECE("PRN^WPN^^^^^BPN^BPN","^",ILOOP)
+32 SET @XFLD@(IREP,3,1)=$PIECE("PH^PH^PH^PH^PH^FX^BP^BP","^",ILOOP)
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 QUIT FEXIT
