| 1 | MAG7UDR ;WOIFO/MLH - HL7 utilities - populate a practitioner field; 12-Jun-2003 ; 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 |  ;
 | 
|---|
| 19 | PRCTADD(XFLD,XTYP) ; FUNCTION - add a practitioner to a field array
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 |  ; Input:    XFLD       name of array into which to populate
 | 
|---|
| 22 |  ;                        (see MAG7UP for structure)
 | 
|---|
| 23 |  ;           XTYP       type of practitioner:
 | 
|---|
| 24 |  ;                        'ATT' = attending, 'REF' = referring
 | 
|---|
| 25 |  ; 
 | 
|---|
| 26 |  ; Expects:  Fileman variables from call to DI or Kernel
 | 
|---|
| 27 |  ;           DFN        IEN of patient on ^DPT
 | 
|---|
| 28 |  ; 
 | 
|---|
| 29 |  ; function return:     error status (default = '0', false)
 | 
|---|
| 30 |  ; 
 | 
|---|
| 31 |  N FEXIT ; ------- exit status flag
 | 
|---|
| 32 |  N VAIN ; -------- array of inpatient data from PIMS
 | 
|---|
| 33 |  N REP ; --------- repetition index for the XFLD array
 | 
|---|
| 34 |  N PRCT ; -------- practitioner data
 | 
|---|
| 35 |  N MAGPHYNM ; ---- physician name
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 |  S FEXIT=0 ; default to no error
 | 
|---|
| 38 |  D INP^VADPT ; populate inpatient data into VAIN()
 | 
|---|
| 39 |  S REP=$O(@XFLD@(" "),-1)+1 ; get next repetition of the XFLD array
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 |  ; populate field array based on practitioner type
 | 
|---|
| 42 |  I "^ATT^REF^"'[("^"_$G(XTYP)_"^") D  Q FEXIT
 | 
|---|
| 43 |  . S FEXIT="-1;no practitioner type sent to PRCTADD^"_$T(+0)
 | 
|---|
| 44 |  . Q
 | 
|---|
| 45 |  S PRCT=$S(XTYP="ATT":VAIN(2),XTYP="REF":VAIN(11),1:"")
 | 
|---|
| 46 |  S @XFLD@(REP,1,1)=$P(PRCT,U) ; ---------- ID number
 | 
|---|
| 47 |  S MAGPHYNM=$P(PRCT,"^",2) ; full name
 | 
|---|
| 48 |  S @XFLD@(REP,2,1)=$P(MAGPHYNM,",") ; ------- family name
 | 
|---|
| 49 |  S MAGPHYNM=$P(MAGPHYNM,",",2,99) ; strip last name
 | 
|---|
| 50 |  S @XFLD@(REP,3,1)=$P(MAGPHYNM," ") ; ------- given name
 | 
|---|
| 51 |  S @XFLD@(REP,4,1)=$P(MAGPHYNM," ",2,99) ; -- 2nd & further given nms
 | 
|---|
| 52 |  Q FEXIT
 | 
|---|