Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVRPCPT

WVRPCPT.m

Go to the documentation of this file.
WVRPCPT ;HIOFO/FT - WV PATIENT FILE (790) APIS AND RPCS ;Mar 24, 2020@15:24
 ;;1.0;WOMEN'S HEALTH;**16,24**;Sep 30, 1998;Build 582
 ;
BRTX(DFN,BRTX,BRDD,CRTX,CRDD,WVPDATE) ; Update the patient's treatment needs and
 ; due dates in WV PATIENT file (790)
 ;  Input:  DFN - patient DFN [required]
 ;         BRTX - breast treatment need IEN (790.51) [optional]
 ;         BRDD - breast treatment need offset (e.g., 1Y) [optional]
 ;         CRTX - cervical treament need IEN (790.5) [optional]
 ;         CRDD - cervical treatment need offset (e.g., 90D) [optional]
 ;      WVPDATE - date procedure was performed [optional]
 ;                default is today
 ; Output: <none>
 Q:'DFN
 Q:'$D(^WV(790,DFN,0))
 S:'$D(BRTX) BRTX=""
 S:'$D(BRDD) BRDD=""
 S:'$D(CRTX) CRTX=""
 S:'$D(CRDD) CRDD=""
 S:'$G(WVPDATE) WVPDATE=DT
 N WVDATE,WVFDA
 S:BRTX]"" WVFDA(790,DFN_",",.18)=BRTX
 I BRDD]"" D
 .S WVDATE=$$FMADD^WVUTL3(BRDD,WVPDATE)
 .S:WVDATE>0 WVFDA(790,DFN_",",.19)=WVDATE
 .Q
 S:CRTX]"" WVFDA(790,DFN_",",.11)=CRTX
 I CRDD]"" D
 .S WVDATE=$$FMADD^WVUTL3(CRDD,WVPDATE)
 .S:WVDATE>0 WVFDA(790,DFN_",",.12)=WVDATE
 .Q
 I $D(WVFDA) D FILE^DIE("","WVFDA","WVERR")
 Q
 ;
GETDATA(RESULT,WVDFN,WVTYPE,WVSDATE,WVEDATE,WVMAX,WVDIR,WVDT) ;RETURN REQUESTED DATA
 ; INPUT: RESULT - SUBSCRIPT UNDER WHICH TO RETURN DATA OR ERROR MESSAGES
 ;                 [REQUIRED]
 ;        WVDFN - IEN OF PATIENT IN WV PATIENT FILE [REQUIRED]
 ;        WVTYPE - TYPE OF DATA TO RETURN [REQUIRED]:
 ;                 "P": PREGNANCY DATA
 ;                 "L": LACTATION DATA
 ;        WVSDATE - START DATE IN INTERNAL FILEMAN FORMAT [OPTIONAL]
 ;                  DEFAULT: NO DATE RANGE RESTRICTION
 ;        WVEDATE - END DATE IN INTERNAL FILEMAN FORMAT [OPTIONAL]
 ;                  DEFAULT: NO DATE RANGE RESTRICTION
 ;        WVMAX - MAXIMUM NUMBER OF ENTRIES TO RETURN [OPTIONAL]
 ;                DEFAULT: RETURN ALL DATA
 ;        WVDIR - SEARCH DIRECTION [OPTIONAL]:
 ;                1:CHRONOLOGICAL ORDER
 ;                -1: REVERSE CHRONOLOGICAL ORDER [DEFAULT]
 ;        WVDT - THE DATE (IN FILEMAN INTERNAL FORMAT) TO USE AS TODAY'S DATE [OPTIONAL]
 ;               DEFAULT: VALUE STORED IN DT VARIABLE
 ; OUTPUT: ^TMP(RESULT,$J)=NUMBER OF ENTRIES RETURNED
 ;                         -1^Error message
 ;         ^TMP(RESULT,$J,N,"FIELD NAME")=INTERNAL_FORMAT^EXTERNAL FORMAT
 I $G(RESULT)="" S RESULT="WVDATA"
 K ^TMP(RESULT,$J)
 I $G(WVDFN)'?1.N D  Q
 .S ^TMP(RESULT,$J)="-1"_U_"Invalid parameter: WVDFN="_$G(WVDFN)
 N WVFILE,WVCOUNT
 S WVFILE=$S(WVTYPE="P":790.05,WVTYPE="L":790.16,1:""),WVCOUNT=0
 I $G(WVFKST) D  Q
 .S WVCOUNT=1+WVCOUNT,^TMP(RESULT,$J)=WVCOUNT
 .D SETARRAY(WVFILE,.01,$$NOW^XLFDT),SETARRAY(WVFILE,21,1)
 .I WVTYPE="P" D SETARRAY(WVFILE,42,DT),SETARRAY(,"P2",0)
 .I WVTYPE="L" D SETARRAY(,"P2",1)
 I '$D(^WV(790,WVDFN)) D  Q
 .S ^TMP(RESULT,$J)="-1"_U_"The specified patient is not in the WV PATIENT file"
 I "^P^L^"'[U_$G(WVTYPE)_U!($G(WVTYPE)="") D  Q
 .S ^TMP(RESULT,$J)="-1"_U_"Invalid parameter: WVTYPE="_$G(WVTYPE)
 S WVDIR=$G(WVDIR,-1)
 I '(WVDIR=1!(WVDIR=-1)) D  Q
 .S ^TMP(RESULT,$J)="-1"_U_"Invalid parameter: WVDIR="_WVDIR
 N WVIDX,WVDATE,WVTEMP
 S WVDATE(1)=+$G(WVSDATE),WVDATE(2)=+$G(WVEDATE)
 M WVTEMP=WVDATE
 I (WVDIR=1&(WVDATE(1)>WVDATE(2)))!((WVDIR=-1&(WVDATE(2)>WVDATE(1)))) D
 .S WVDATE(1)=WVTEMP(2),WVDATE(2)=WVTEMP(1)
 I WVDATE(1)=0,WVDIR=-1 S WVDATE(1)="?"
 S WVMAX=$G(WVMAX)
 I WVMAX<0 D  Q
 .S ^TMP(RESULT,$J)="-1"_U_"Invalid parameter: WVMAX="_WVMAX
 N WVPATDT,WVDATES
 I $$INSTALDT^XPDUTL("WV*1.0*24",.WVDATES)>0 S WVPATDT=$O(WVDATES(0))
 E  S WVPATDT=$$DT^XLFDT
 N WVSUB,WVIEN,WVEXIT,WVPNUM,WVNODE,WVDTE,WVINDEX
 S WVSUB=$S(WVTYPE="P":4,WVTYPE="L":5,1:""),WVDTE=0
 F  S WVDTE=$O(^WV(790,WVDFN,WVSUB,"B",WVDTE)) Q:'+WVDTE  S WVINDEX=0 F  S WVINDEX=$O(^WV(790,WVDFN,WVSUB,"B",WVDTE,WVINDEX)) Q:'+WVINDEX  D
 .Q:$P($G(^WV(790,WVDFN,WVSUB,WVINDEX,0)),U,6)=1!('$D(^WV(790,WVDFN,WVSUB,WVINDEX)))
 .S WVINDEX(WVDTE,WVINDEX)=""
 S WVDATE=WVDATE(1)
 F  S WVDATE=$O(WVINDEX(WVDATE),WVDIR) Q:WVDATE=""!($G(WVEXIT))!(WVCOUNT=WVMAX)  D
 .I WVDATE(2)>0 D  Q:$G(WVEXIT)
 ..I WVDIR=-1,WVDATE<WVDATE(2) S WVEXIT=1 Q
 ..I WVDIR=1,WVDATE>WVDATE(2) S WVEXIT=1 Q
 .S WVIEN=$S(WVDIR=-1:"?",1:0) F  S WVIEN=$O(WVINDEX(WVDATE,WVIEN),WVDIR) Q:WVIEN=""!($G(WVEXIT))!(WVCOUNT=WVMAX)  D
 ..S WVCOUNT=WVCOUNT+1,WVNODE=$G(^WV(790,WVDFN,WVSUB,WVIEN,0))
 ..S ^TMP(RESULT,$J,WVCOUNT,"RECORD ID")=WVIEN_","_WVDFN_","
 ..S ^TMP(RESULT,$J,WVCOUNT,"VISIT STRING")=$$VSTRING^WVUTL11($P(WVNODE,U,4))
 ..D SETARRAY(WVFILE,.01,$P(WVNODE,U))
 ..D SETARRAY(WVFILE,3,$P(WVNODE,U,3))
 ..D SETARRAY(WVFILE,5,$P(WVNODE,U,5))
 ..S WVNODE=$G(^WV(790,WVDFN,WVSUB,WVIEN,2))
 ..F WVPNUM=1:1:$L(WVNODE,U)  D
 ...Q:$P(WVNODE,U,WVPNUM)=""
 ...D SETARRAY(WVFILE,"2"_WVPNUM,$P(WVNODE,U,WVPNUM))
 ..I WVTYPE="P" D
 ...I $O(^WV(790,WVDFN,WVSUB,WVIEN,3,0))'="" D
 ....N WVSIEN,WVRLEVEL
 ....S WVSIEN=0 F  S WVSIEN=$O(^WV(790,WVDFN,WVSUB,WVIEN,3,WVSIEN)) Q:'WVSIEN!($G(WVRLEVEL)<0)  D
 .....S WVNODE=$G(^WV(790,WVDFN,WVSUB,WVIEN,3,WVSIEN,0))
 .....D SETARRAY(790.17,.01,$P(WVNODE,U),WVSIEN)
 .....N WVLEVEL
 .....S WVLEVEL=$$MOA^WVUTL11($P(WVNODE,U),WVDFN,$G(WVDT,DT))
 .....I WVLEVEL=-1!($G(WVRLEVEL)>-1&(WVLEVEL>$G(WVRLEVEL))) S WVRLEVEL=WVLEVEL
 ....D SETARRAY(,"P1",$G(WVRLEVEL))
 ...S WVNODE=$G(^WV(790,WVDFN,WVSUB,WVIEN,4))
 ...F WVPNUM=1:1:$L(WVNODE,U)  D
 ....Q:$P(WVNODE,U,WVPNUM)=""
 ....D SETARRAY(WVFILE,"4"_WVPNUM,$P(WVNODE,U,WVPNUM))
 ...N WVSTATUS,WVDSS
 ...S WVSTATUS=$P($G(^TMP(RESULT,$J,WVCOUNT,"PREGNANCY STATE")),U,2)
 ...I $P(^TMP(RESULT,$J,WVCOUNT,"DATA SOURCE"),U,2)="WOMEN'S HEALTH",$P(^TMP(RESULT,$J,WVCOUNT,"PREGNANCY STATUS D/T ENTERED"),U)<WVPATDT D  Q
 ....I WVSTATUS="PREGNANT" D
 .....D SETARRAY(,"P2",$S($D(^TMP(RESULT,$J,WVCOUNT,"EDD"))=1:1,1:0))
 ....I WVSTATUS'="PREGNANT" D SETARRAY(,"P2",1)
 ...I $D(^TMP(RESULT,$J,WVCOUNT,"MEDICALLY UNABLE TO CONCEIVE"))=0 D SETARRAY(,"P2",0) Q
 ...I $P(^TMP(RESULT,$J,WVCOUNT,"MEDICALLY UNABLE TO CONCEIVE"),U)=1 D
 ....I '$D(^TMP(RESULT,$J,WVCOUNT,"MEDICAL REASON")) D SETARRAY(,"P2",0)
 ...I WVSTATUS="PREGNANT" D
 ....D SETARRAY(,"P2",$S($D(^TMP(RESULT,$J,WVCOUNT,"EDD"))=1:1,1:0))
 ...I WVSTATUS'="PREGNANT" D
 ....I $P(^TMP(RESULT,$J,WVCOUNT,"MEDICALLY UNABLE TO CONCEIVE"),U)=0 D  Q:$G(WVDSS)
 .....I $D(^TMP(RESULT,$J,WVCOUNT,"TRYING TO BECOME PREGNANT"))=0 D SETARRAY(,"P2",0) S WVDSS=1 Q
 .....I '$P(^TMP(RESULT,$J,WVCOUNT,"TRYING TO BECOME PREGNANT"),U),$D(^TMP(RESULT,$J,WVCOUNT,"CONTRACEPTIVE METHOD USED"))'=10 D  Q
 ......D SETARRAY(,"P2",0)
 ......S WVDSS=1
 ....I $$ISPREG^WVUTL11(WVDFN,,,1),$D(^TMP(RESULT,$J,WVCOUNT,"PREGNANCY END DATE"))=0 D SETARRAY(,"P2",0) Q
 ....I $D(^TMP(RESULT,$J,WVCOUNT,"PREGNANCY END DATE"))=1,$D(^TMP(RESULT,$J,WVCOUNT,"REASON PREGNANCY ENDED"))'=1 D SETARRAY(,"P2",0) Q
 ....D SETARRAY(,"P2",1)
 ...Q:$P(^TMP(RESULT,$J,WVCOUNT,"MEDICALLY UNABLE TO CONCEIVE"),U)=1
 ...I WVSTATUS="" D SETARRAY(,"P2",0)
 ...I '$D(^TMP(RESULT,$J,WVCOUNT,"DOCUMENTATION STATUS")) D SETARRAY(,"P2",1)
 ..I WVTYPE="L" D
 ...I $P($G(^TMP(RESULT,$J,WVCOUNT,"LACTATION STATE")),U)=0&('$D(^TMP(RESULT,$J,WVCOUNT,"END DATE")))&($P($G(^WV(790,WVDFN,WVSUB,0)),U,4)>1) D  Q
 ....N WVPIEN
 ....S WVPIEN=+$O(WVINDEX(WVDATE),-1) I WVPIEN>0 S WVPIEN=+$O(WVINDEX(WVPIEN,0))
 ....I WVPIEN>0,$P($G(^WV(790,WVDFN,WVSUB,WVPIEN,2)),U)=1 D SETARRAY(,"P2",0) Q
 ....D SETARRAY(,"P2",1)
 ...D SETARRAY(,"P2",1)
 S ^TMP(RESULT,$J)=WVCOUNT
 Q
 ;
PFIELDS ;PSEUDO-FIELD DEFINITIONS
 ;;PREGNANCY LIKELIHOOD^S $P(WVDATA,U,2)=$S(WVDATA=1:"HIGH",WVDATA=2:"LOW",WVDATA=-1:"CALCULATION ERROR",1:"UNKNOWN")
 ;;DOCUMENTATION STATUS^S $P(WVDATA,U,2)=$S(WVDATA=0:"INCOMPLETE",WVDATA=1:"COMPLETE",1:"UNKNOWN")
SAVEDATA(WVRETURN,WVDATA) ;SAVE DATA FROM CLINICAL REMINDERS
 ; INPUT: WVRETURN - REFERENCE TO ARRAY IN WHICH TO RETURN STATUS
 ;                   [REQUIRED]
 ;        WVDATA - REFERENCE TO ARRAY OF DATA TO SAVE
 ;                 [REQUIRED]
 N WVFILE
 S WVFILE=0 F  S WVFILE=$O(WVDATA("DATA",WVFILE)) Q:WVFILE=""!(+$G(WVRETURN(1))<0)  D
 .I "^790^790.05^790.17^790.16^790.9^790.1^790.4^790.23^"'[(U_WVFILE_U) S WVRETURN(1)=-1_U_"Invalid file number: "_WVFILE
 Q:$D(WVRETURN)
 I $G(WVDATA("DFN"))'?1.N D  Q
 .S WVRETURN(1)=-1_U_"Invalid patient identifier: "_$G(WVDATA("DFN"),"No identifer specified.")
 N WVNPFLAG
 S WVNPFLAG=$$ISREG^WVUTL11(WVDATA("DFN"))
 I '+WVNPFLAG S WVRETURN(1)=-1_U_$P(WVNPFLAG,U,2) Q
 I $D(WVDATA("DATA",790)) D
 .N WVID
 .S WVID=$O(WVDATA("DATA",790,"")) Q:WVID=""
 .I WVID["+" M WVDATA("DATA",790,WVDATA("DFN")_",")=WVDATA("DATA",790,WVID) K WVDATA("DATA",790,WVID)
 I $D(WVDATA("DATA",790))!($D(WVDATA("DATA",790.1)))!($D(WVDATA("DATA",790.4)))!($D(WVDATA("DATA",790.23))) D NEW^WVRPCGF(.WVRETURN,.WVDATA)
 I $D(WVDATA("DATA",790.9)) S WVRETURN(1)=$$CLRSRND^WVRPCPT1(WVDATA("DFN"),$E(WVDATA("DATA",790.9,$O(WVDATA("DATA",790.9,"")),.01),*))
 Q:+$G(WVRETURN(1))=-1
 N WVERROR,WVCMNEW,WVIEN,WVNEWREC,WVREC,WVFIELD,WVVPR
 N WVFDA,WVARRAY,WVCMIEN,WV79005NR,WVENTRY,WVVIEN,WVSEQ
 I $G(WVDATA("VISIT"))="" S WVVIEN=0
 E  D  Q:+$G(WVRETURN(1))=-1
 .S WVVIEN=$$VISITIEN^WVUTL11(WVDATA("DFN"),$G(WVDATA("VISIT")))
 .I WVVIEN<1 D
 ..F WVFILE=790.05,790.16  D  Q:+$G(WVRETURN(1))<0
 ...Q:'$D(WVDATA("DATA",WVFILE))
 ...I $G(WVDATA("DATA",WVFILE,"MASTER ID"))="" D  Q
 ....S WVRETURN(1)=-1_U_"Invalid VISIT file entry specified: "_$G(WVDATA("VISIT"))
 D CHKIENS(.WVDATA)
 D EXTRTDAT^WVRPCVPR(+$$GETLREC^WVRPCOR(WVDATA("DFN"),4)_","_WVDATA("DFN")_",","BEFORE")
 ;Ensure records are complete and then save data (contraceptive methods handled separately)
 S WVFILE=0 F  S WVFILE=$O(WVDATA("DATA",WVFILE)) Q:'WVFILE!(+$G(WVRETURN(1))<0)  D
 .I "^790^790.1^790.4^790.9^790.23^"[(U_WVFILE_U) Q
 .S WVARRAY=$S(WVFILE=790.17:"WVCMNEW",1:"WVFDA")
 .S WVREC="" F  S WVREC=$O(WVDATA("DATA",WVFILE,WVREC)) Q:'WVREC!($P($G(WVRETURN(1)),U)=-1)  D
 ..S WVNEWREC=$S($E(WVREC,1)="+":1,1:0),WVENTRY=""
 ..I WVFILE=790.17,WVREC["?" S WVENTRY=$P(WVREC,"?")_WVCMIEN_","_$P($P(WVREC,"?",2),",",2,$L($P(WVREC,"?",2),","))
 ..M @WVARRAY@(WVFILE,$S(WVENTRY'="":WVENTRY,1:WVREC))=WVDATA("DATA",WVFILE,WVREC)
 ..Q:'$D(WVFDA)
 ..I WVNEWREC,$D(WVFDA(WVFILE,WVREC)),'$D(WVFDA(WVFILE,WVREC,.01)) S WVFDA(WVFILE,WVREC,.01)=$$NOW^XLFDT
 ..I WVVIEN>0,'$D(WVFDA(WVFILE,WVREC,4)) S WVFDA(WVFILE,WVREC,4)="`"_WVVIEN
 ..I $G(WVDATA("DOCUMENT"))>0 S WVFDA(WVFILE,WVREC,5)="`"_WVDATA("DOCUMENT")
 ..D VALENTRY(WVFILE,WVREC,.WVFDA,WVNEWREC)
 ..D:$G(WVNEWREC) UPDATE^DIE("E","WVFDA","WVIEN","WVERROR")
 ..D:'$G(WVNEWREC) FILE^DIE("EK","WVFDA","WVERROR")
 ..I WVFILE=790.05 D
 ...I WVNEWREC S WVSEQ=$P($P(WVREC,",",1),"+",2),WVCMIEN=$G(WVIEN(WVSEQ))
 ...E  S WVCMIEN=$P(WVREC,",")
 ...S WVCMIEN(1)=$P(WVREC,",",2),WV79005NR=WVNEWREC
 ...S WVVPR("AFTER")=$S(WVNEWREC:$G(WVIEN(WVSEQ))_","_WVDATA("DFN")_",",1:WVREC)
 ..I $D(WVERROR) S WVRETURN(1)=-1_U_"Unable to save/update the status data: "_$$FMERROR^WVUTL11(.WVERROR)
 Q:+$G(WVRETURN(1))=-1
 I $D(WVDATA("DATA",790.05))!($D(WVDATA("DATA",790.17))) D
 .S WVRETURN(1)=$$METHOD^WVTDALRT(WVDATA("DFN"),.WVCMIEN,+$G(WV79005NR),.WVCMNEW)
 .D NOTIFY^WVRPCVPR(.WVVPR)
 I '$D(WVRETURN(1)) S WVRETURN(1)=1
 Q
 ;
VALENTRY(WVFILE,WVENTRY,WVFDA,WVNEWREC) ;VALIDATE THE DATA TO FILE
 ;INPUT: WVFILE - FILE NUMBER IN WHICH DATA WILL BE SAVED [REQUIRED]
 ;       WVENTRY - FILEMAN IENS VALUE OF THE ENTRY IN THE FILE [REQUIRED]
 ;       WVFDA - REFERENCE TO ARRAY CONTAINING THE NEW ENTRY
 I $D(WVFDA(WVFILE,WVENTRY,23)) K WVFDA(WVFILE,WVENTRY,24) ;WIPE OUT LATER FIELDS IF MUC REASON IS SET
 N WVFIELD,WVVALUE
 ;HANDLE BLANK FIELD VALUES
 S WVFIELD="" F  S WVFIELD=$O(WVFDA(WVFILE,WVENTRY,WVFIELD)) Q:WVFIELD=""  D
 .S WVVALUE=$G(WVFDA(WVFILE,WVENTRY,WVFIELD)) Q:WVVALUE'=""
 .I WVNEWREC K WVFDA(WVFILE,WVENTRY,WVFIELD)
 .I 'WVNEWREC S WVFDA(WVFILE,WVENTRY,WVFIELD)="@"
 Q
 ;
CHKIENS(WVDATA) ;ENSURE IENS ARE COMPLETE AND ACCURATE
 ;INPUT: WVDATA - REFERENCE TO ARRAY CONTAINING DATA TO CHECK
 N WVLEVELS,WVLEVEL,WVIEN,WVFILE,WVMIENS,WVIENS,WVENTRY,WVUPLVL,WVPFILE,WVPLCHDR,WVID,WVSTRIP,WVNEWPH,WVPDIENS
 ;WVLEVELS(LEVEL_#,FILE_#)=PARENT_FILE_#
 S WVLEVELS(1,790)="",WVLEVELS(2,790.05)=790,WVLEVELS(2,790.16)=790,WVLEVELS(3,790.17)=790.05
 S WVLEVELS(1,790.1)="",WVLEVELS(2,790.23)=790.1,WVLEVELS(1,790.4)=""
 S WVSTRIP("+")="?"
 S WVIEN(790)=$G(WVDATA("DFN"))
 S WVLEVEL=0 F  S WVLEVEL=$O(WVLEVELS(WVLEVEL)) Q:'+WVLEVEL  D
 .S WVFILE=0 F  S WVFILE=$O(WVLEVELS(WVLEVEL,WVFILE)) Q:'+WVFILE  D
 ..Q:'$D(WVDATA("DATA",WVFILE))
 ..K WVPDIENS
 ..S WVMIENS=$P($G(WVDATA("DATA",WVFILE,"MASTER ID")),":"),WVNEWPH=0
 ..S WVIENS="" F  S WVIENS=$O(WVDATA("DATA",WVFILE,WVIENS)) Q:WVIENS=""  D
 ...I (WVIENS="MASTER ID")!($D(WVPDIENS(WVIENS))) Q
 ...I $E(WVIENS,1)="+" D
 ....S WVID=$E(WVIENS,2,$L($P(WVIENS,",")))
 ....I $D(WVPLCHDR(WVID)) S WVPLCHDR=WVPLCHDR+1,WVPLCHDR(WVPLCHDR)="",WVNEWPH=1
 ....E  S WVPLCHDR(WVID)="",WVPLCHDR=WVID
 ...S WVIEN(WVFILE)=$S(WVNEWPH:"+"_WVPLCHDR,1:$P(WVIENS,","))
 ...I $L(WVIENS,",")<(WVLEVEL+1) D
 ....S WVENTRY=WVIEN(WVFILE)_","
 ....S WVUPLVL=WVLEVEL+1,WVPFILE=WVFILE F  S WVUPLVL=$O(WVLEVELS(WVUPLVL),-1) Q:'+WVUPLVL  S WVPFILE=WVLEVELS(WVUPLVL,WVPFILE) I WVPFILE'="" S WVENTRY=WVENTRY_WVIEN(WVPFILE)_","
 ....S $P(WVENTRY,",",2,$L(WVENTRY,","))=$$REPLACE^XLFSTR($P(WVENTRY,",",2,$L(WVENTRY,",")),.WVSTRIP)
 ....M WVDATA("DATA",WVFILE,WVENTRY)=WVDATA("DATA",WVFILE,WVIENS)
 ....K WVDATA("DATA",WVFILE,WVIENS)
 ....S WVIENS="",WVPDIENS(WVENTRY)=""
 ...I WVIENS'="" S WVPDIENS(WVIENS)=""
 ..I WVMIENS'="" K WVDATA("DATA",WVFILE,"MASTER ID")
 Q
SETARRAY(WVFILE,WVFIELD,WVDATA,WVMSUB) ;SET DATA INTO THE RETURN ARRAY
 ; INPUT: WVFILE - FILE NUMBER CONTAINING THE FIELD [REQUIRED]
 ;        WVFIELD - FIELD NUMBER [REQUIRED]
 ;        WVDATA - INTERNAL VALUE OF THE FIELD [REQUIRED]
 ;        WVMSUB - SUBSCRIPT WITHIN THE TMP GLOBAL TO RETURN DATA IN
 N WVSUB
 I $E(WVFIELD,1)="P" D
 .N WVCODE,WVLINE
 .S WVLINE=$E(WVFIELD,2,*)
 .S WVSUB=$P($P($T(PFIELDS+WVLINE),";;",2),U)
 .S WVCODE=$P($P($T(PFIELDS+WVLINE),";;",2),U,2)
 .X:WVCODE'="" WVCODE
 I $E(WVFIELD,1)'="P" D
 .S WVSUB=$$GET1^DID(WVFILE,WVFIELD,,"LABEL")
 .S $P(WVDATA,U,2)=$$EXTERNAL^DILFD(WVFILE,WVFIELD,"",WVDATA)
 I $G(WVMSUB)>0 S ^TMP(RESULT,$J,WVCOUNT,WVSUB,WVMSUB)=WVDATA
 E  S ^TMP(RESULT,$J,WVCOUNT,WVSUB)=WVDATA
 Q
 ;