- 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 Jan 18, 2025@03:00:36 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