WVRPCPT ;HIOFO/FT - WV PATIENT FILE (790) APIS AND RPCS ;Apr 05, 2021@14:28
;;1.0;WOMEN'S HEALTH;**16,24,26**;Sep 30, 1998;Build 624
;
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^WVRPCPT2(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^WVUTL11(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
;
GETSTATUS(WVDFN) ;RETURN SINGLE LINE PREGNANT/LACTATING
N WVPOST,WVINDEX,WVRET,WVTEXT,WVSUB
D POSTLIST^WVRPCOR(.WVPOST,WVDFN,.WVINDEX)
S WVINDEX=0 F S WVINDEX=$O(WVPOST(WVINDEX)) Q:WVINDEX="" D
.S WVTEXT=$P(WVPOST(WVINDEX),U,2)
.S WVRET=$S($G(WVRET)'="":WVRET_" and ",1:"")_WVTEXT
.I WVTEXT'="Pregnant" Q
.S WVSUB(1)=$$GETSUB^WVRPCOR(WVDFN)
.S WVSUB(2)=$P($P($G(^XTMP(WVSUB(1),"POSTINGS","P")),";",2),",",1)
.I WVSUB(2)="" Q
.S WVRET=WVRET_" (Expected Due Date: "_$$FMTE^XLFDT($P($G(^WV(790,WVDFN,4,WVSUB(2),4)),U,2))_")"
Q $G(WVRET)
GETEDD(WVDFN) ;RETURN EDD AND WEEKS GESTATION
N WVREC,WVEDD,WVGA,WVRESULT,WVSTATUS
S WVRESULT=$NA(^TMP("WVEDD",$J))
S WVREC=$$GETLREC^WVUTL11(WVDFN,4)
S WVSTATUS=$P($G(^WV(790,WVDFN,4,+WVREC,2)),U,1)
I WVSTATUS'=1 S @WVRESULT@(1,0)="" Q "~@"_WVRESULT
S WVEDD=$P($G(^WV(790,WVDFN,4,+WVREC,4)),U,2)
S @WVRESULT@(1,0)="Expected Due Date: "_$$FMTE^XLFDT(WVEDD)
S WVGA=$P(((280-$$FMDIFF^XLFDT(WVEDD,DT,1))/7),".",1)
I $P(WVREC,U,4)=1 S @WVRESULT@(2,0)="Gestational Age: "_WVGA_" weeks"
Q "~@"_WVRESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPCPT 15526 printed Apr 09, 2024@21:49:18 Page 2
WVRPCPT ;HIOFO/FT - WV PATIENT FILE (790) APIS AND RPCS ;Apr 05, 2021@14:28
+1 ;;1.0;WOMEN'S HEALTH;**16,24,26**;Sep 30, 1998;Build 624
+2 ;
BRTX(DFN,BRTX,BRDD,CRTX,CRDD,WVPDATE) ; Update the patient's treatment needs and
+1 ; due dates in WV PATIENT file (790)
+2 ; Input: DFN - patient DFN [required]
+3 ; BRTX - breast treatment need IEN (790.51) [optional]
+4 ; BRDD - breast treatment need offset (e.g., 1Y) [optional]
+5 ; CRTX - cervical treament need IEN (790.5) [optional]
+6 ; CRDD - cervical treatment need offset (e.g., 90D) [optional]
+7 ; WVPDATE - date procedure was performed [optional]
+8 ; default is today
+9 ; Output: <none>
+10 if 'DFN
QUIT
+11 if '$DATA(^WV(790,DFN,0))
QUIT
+12 if '$DATA(BRTX)
SET BRTX=""
+13 if '$DATA(BRDD)
SET BRDD=""
+14 if '$DATA(CRTX)
SET CRTX=""
+15 if '$DATA(CRDD)
SET CRDD=""
+16 if '$GET(WVPDATE)
SET WVPDATE=DT
+17 NEW WVDATE,WVFDA
+18 if BRTX]""
SET WVFDA(790,DFN_",",.18)=BRTX
+19 IF BRDD]""
Begin DoDot:1
+20 SET WVDATE=$$FMADD^WVUTL3(BRDD,WVPDATE)
+21 if WVDATE>0
SET WVFDA(790,DFN_",",.19)=WVDATE
+22 QUIT
End DoDot:1
+23 if CRTX]""
SET WVFDA(790,DFN_",",.11)=CRTX
+24 IF CRDD]""
Begin DoDot:1
+25 SET WVDATE=$$FMADD^WVUTL3(CRDD,WVPDATE)
+26 if WVDATE>0
SET WVFDA(790,DFN_",",.12)=WVDATE
+27 QUIT
End DoDot:1
+28 IF $DATA(WVFDA)
DO FILE^DIE("","WVFDA","WVERR")
+29 QUIT
+30 ;
GETDATA(RESULT,WVDFN,WVTYPE,WVSDATE,WVEDATE,WVMAX,WVDIR,WVDT) ;RETURN REQUESTED DATA
+1 ; INPUT: RESULT - SUBSCRIPT UNDER WHICH TO RETURN DATA OR ERROR MESSAGES
+2 ; [REQUIRED]
+3 ; WVDFN - IEN OF PATIENT IN WV PATIENT FILE [REQUIRED]
+4 ; WVTYPE - TYPE OF DATA TO RETURN [REQUIRED]:
+5 ; "P": PREGNANCY DATA
+6 ; "L": LACTATION DATA
+7 ; WVSDATE - START DATE IN INTERNAL FILEMAN FORMAT [OPTIONAL]
+8 ; DEFAULT: NO DATE RANGE RESTRICTION
+9 ; WVEDATE - END DATE IN INTERNAL FILEMAN FORMAT [OPTIONAL]
+10 ; DEFAULT: NO DATE RANGE RESTRICTION
+11 ; WVMAX - MAXIMUM NUMBER OF ENTRIES TO RETURN [OPTIONAL]
+12 ; DEFAULT: RETURN ALL DATA
+13 ; WVDIR - SEARCH DIRECTION [OPTIONAL]:
+14 ; 1:CHRONOLOGICAL ORDER
+15 ; -1: REVERSE CHRONOLOGICAL ORDER [DEFAULT]
+16 ; WVDT - THE DATE (IN FILEMAN INTERNAL FORMAT) TO USE AS TODAY'S DATE [OPTIONAL]
+17 ; DEFAULT: VALUE STORED IN DT VARIABLE
+18 ; OUTPUT: ^TMP(RESULT,$J)=NUMBER OF ENTRIES RETURNED
+19 ; -1^Error message
+20 ; ^TMP(RESULT,$J,N,"FIELD NAME")=INTERNAL_FORMAT^EXTERNAL FORMAT
+21 IF $GET(RESULT)=""
SET RESULT="WVDATA"
+22 KILL ^TMP(RESULT,$JOB)
+23 IF $GET(WVDFN)'?1.N
Begin DoDot:1
+24 SET ^TMP(RESULT,$JOB)="-1"_U_"Invalid parameter: WVDFN="_$GET(WVDFN)
End DoDot:1
QUIT
+25 NEW WVFILE,WVCOUNT
+26 SET WVFILE=$SELECT(WVTYPE="P":790.05,WVTYPE="L":790.16,1:"")
SET WVCOUNT=0
+27 IF $GET(WVFKST)
Begin DoDot:1
+28 SET WVCOUNT=1+WVCOUNT
SET ^TMP(RESULT,$JOB)=WVCOUNT
+29 DO SETARRAY(WVFILE,.01,$$NOW^XLFDT)
DO SETARRAY(WVFILE,21,1)
+30 IF WVTYPE="P"
DO SETARRAY(WVFILE,42,DT)
DO SETARRAY(,"P2",0)
+31 IF WVTYPE="L"
DO SETARRAY(,"P2",1)
End DoDot:1
QUIT
+32 IF '$DATA(^WV(790,WVDFN))
Begin DoDot:1
+33 SET ^TMP(RESULT,$JOB)="-1"_U_"The specified patient is not in the WV PATIENT file"
End DoDot:1
QUIT
+34 IF "^P^L^"'[U_$GET(WVTYPE)_U!($GET(WVTYPE)="")
Begin DoDot:1
+35 SET ^TMP(RESULT,$JOB)="-1"_U_"Invalid parameter: WVTYPE="_$GET(WVTYPE)
End DoDot:1
QUIT
+36 SET WVDIR=$GET(WVDIR,-1)
+37 IF '(WVDIR=1!(WVDIR=-1))
Begin DoDot:1
+38 SET ^TMP(RESULT,$JOB)="-1"_U_"Invalid parameter: WVDIR="_WVDIR
End DoDot:1
QUIT
+39 NEW WVIDX,WVDATE,WVTEMP
+40 SET WVDATE(1)=+$GET(WVSDATE)
SET WVDATE(2)=+$GET(WVEDATE)
+41 MERGE WVTEMP=WVDATE
+42 IF (WVDIR=1&(WVDATE(1)>WVDATE(2)))!((WVDIR=-1&(WVDATE(2)>WVDATE(1))))
Begin DoDot:1
+43 SET WVDATE(1)=WVTEMP(2)
SET WVDATE(2)=WVTEMP(1)
End DoDot:1
+44 IF WVDATE(1)=0
IF WVDIR=-1
SET WVDATE(1)="?"
+45 SET WVMAX=$GET(WVMAX)
+46 IF WVMAX<0
Begin DoDot:1
+47 SET ^TMP(RESULT,$JOB)="-1"_U_"Invalid parameter: WVMAX="_WVMAX
End DoDot:1
QUIT
+48 NEW WVPATDT,WVDATES
+49 IF $$INSTALDT^XPDUTL("WV*1.0*24",.WVDATES)>0
SET WVPATDT=$ORDER(WVDATES(0))
+50 IF '$TEST
SET WVPATDT=$$DT^XLFDT
+51 NEW WVSUB,WVIEN,WVEXIT,WVPNUM,WVNODE,WVDTE,WVINDEX
+52 SET WVSUB=$SELECT(WVTYPE="P":4,WVTYPE="L":5,1:"")
SET WVDTE=0
+53 FOR
SET WVDTE=$ORDER(^WV(790,WVDFN,WVSUB,"B",WVDTE))
if '+WVDTE
QUIT
SET WVINDEX=0
FOR
SET WVINDEX=$ORDER(^WV(790,WVDFN,WVSUB,"B",WVDTE,WVINDEX))
if '+WVINDEX
QUIT
Begin DoDot:1
+54 if $PIECE($GET(^WV(790,WVDFN,WVSUB,WVINDEX,0)),U,6)=1!('$DATA(^WV(790,WVDFN,WVSUB,WVINDEX)))
QUIT
+55 SET WVINDEX(WVDTE,WVINDEX)=""
End DoDot:1
+56 SET WVDATE=WVDATE(1)
+57 FOR
SET WVDATE=$ORDER(WVINDEX(WVDATE),WVDIR)
if WVDATE=""!($GET(WVEXIT))!(WVCOUNT=WVMAX)
QUIT
Begin DoDot:1
+58 IF WVDATE(2)>0
Begin DoDot:2
+59 IF WVDIR=-1
IF WVDATE<WVDATE(2)
SET WVEXIT=1
QUIT
+60 IF WVDIR=1
IF WVDATE>WVDATE(2)
SET WVEXIT=1
QUIT
End DoDot:2
if $GET(WVEXIT)
QUIT
+61 SET WVIEN=$SELECT(WVDIR=-1:"?",1:0)
FOR
SET WVIEN=$ORDER(WVINDEX(WVDATE,WVIEN),WVDIR)
if WVIEN=""!($GET(WVEXIT))!(WVCOUNT=WVMAX)
QUIT
Begin DoDot:2
+62 SET WVCOUNT=WVCOUNT+1
SET WVNODE=$GET(^WV(790,WVDFN,WVSUB,WVIEN,0))
+63 SET ^TMP(RESULT,$JOB,WVCOUNT,"RECORD ID")=WVIEN_","_WVDFN_","
+64 SET ^TMP(RESULT,$JOB,WVCOUNT,"VISIT STRING")=$$VSTRING^WVUTL11($PIECE(WVNODE,U,4))
+65 DO SETARRAY(WVFILE,.01,$PIECE(WVNODE,U))
+66 DO SETARRAY(WVFILE,3,$PIECE(WVNODE,U,3))
+67 DO SETARRAY(WVFILE,5,$PIECE(WVNODE,U,5))
+68 SET WVNODE=$GET(^WV(790,WVDFN,WVSUB,WVIEN,2))
+69 FOR WVPNUM=1:1:$LENGTH(WVNODE,U)
Begin DoDot:3
+70 if $PIECE(WVNODE,U,WVPNUM)=""
QUIT
+71 DO SETARRAY(WVFILE,"2"_WVPNUM,$PIECE(WVNODE,U,WVPNUM))
End DoDot:3
+72 IF WVTYPE="P"
Begin DoDot:3
+73 IF $ORDER(^WV(790,WVDFN,WVSUB,WVIEN,3,0))'=""
Begin DoDot:4
+74 NEW WVSIEN,WVRLEVEL
+75 SET WVSIEN=0
FOR
SET WVSIEN=$ORDER(^WV(790,WVDFN,WVSUB,WVIEN,3,WVSIEN))
if 'WVSIEN!($GET(WVRLEVEL)<0)
QUIT
Begin DoDot:5
+76 SET WVNODE=$GET(^WV(790,WVDFN,WVSUB,WVIEN,3,WVSIEN,0))
+77 DO SETARRAY(790.17,.01,$PIECE(WVNODE,U),WVSIEN)
+78 NEW WVLEVEL
+79 SET WVLEVEL=$$MOA^WVUTL11($PIECE(WVNODE,U),WVDFN,$GET(WVDT,DT))
+80 IF WVLEVEL=-1!($GET(WVRLEVEL)>-1&(WVLEVEL>$GET(WVRLEVEL)))
SET WVRLEVEL=WVLEVEL
End DoDot:5
+81 DO SETARRAY(,"P1",$GET(WVRLEVEL))
End DoDot:4
+82 SET WVNODE=$GET(^WV(790,WVDFN,WVSUB,WVIEN,4))
+83 FOR WVPNUM=1:1:$LENGTH(WVNODE,U)
Begin DoDot:4
+84 if $PIECE(WVNODE,U,WVPNUM)=""
QUIT
+85 DO SETARRAY(WVFILE,"4"_WVPNUM,$PIECE(WVNODE,U,WVPNUM))
End DoDot:4
+86 NEW WVSTATUS,WVDSS
+87 SET WVSTATUS=$PIECE($GET(^TMP(RESULT,$JOB,WVCOUNT,"PREGNANCY STATE")),U,2)
+88 IF $PIECE(^TMP(RESULT,$JOB,WVCOUNT,"DATA SOURCE"),U,2)="WOMEN'S HEALTH"
IF $PIECE(^TMP(RESULT,$JOB,WVCOUNT,"PREGNANCY STATUS D/T ENTERED"),U)<WVPATDT
Begin DoDot:4
+89 IF WVSTATUS="PREGNANT"
Begin DoDot:5
+90 DO SETARRAY(,"P2",$SELECT($DATA(^TMP(RESULT,$JOB,WVCOUNT,"EDD"))=1:1,1:0))
End DoDot:5
+91 IF WVSTATUS'="PREGNANT"
DO SETARRAY(,"P2",1)
End DoDot:4
QUIT
+92 IF $DATA(^TMP(RESULT,$JOB,WVCOUNT,"MEDICALLY UNABLE TO CONCEIVE"))=0
DO SETARRAY(,"P2",0)
QUIT
+93 IF $PIECE(^TMP(RESULT,$JOB,WVCOUNT,"MEDICALLY UNABLE TO CONCEIVE"),U)=1
Begin DoDot:4
+94 IF '$DATA(^TMP(RESULT,$JOB,WVCOUNT,"MEDICAL REASON"))
DO SETARRAY(,"P2",0)
End DoDot:4
+95 IF WVSTATUS="PREGNANT"
Begin DoDot:4
+96 DO SETARRAY(,"P2",$SELECT($DATA(^TMP(RESULT,$JOB,WVCOUNT,"EDD"))=1:1,1:0))
End DoDot:4
+97 IF WVSTATUS'="PREGNANT"
Begin DoDot:4
+98 IF $PIECE(^TMP(RESULT,$JOB,WVCOUNT,"MEDICALLY UNABLE TO CONCEIVE"),U)=0
Begin DoDot:5
+99 IF $DATA(^TMP(RESULT,$JOB,WVCOUNT,"TRYING TO BECOME PREGNANT"))=0
DO SETARRAY(,"P2",0)
SET WVDSS=1
QUIT
+100 IF '$PIECE(^TMP(RESULT,$JOB,WVCOUNT,"TRYING TO BECOME PREGNANT"),U)
IF $DATA(^TMP(RESULT,$JOB,WVCOUNT,"CONTRACEPTIVE METHOD USED"))'=10
Begin DoDot:6
+101 DO SETARRAY(,"P2",0)
+102 SET WVDSS=1
End DoDot:6
QUIT
End DoDot:5
if $GET(WVDSS)
QUIT
+103 IF $$ISPREG^WVUTL11(WVDFN,,,1)
IF $DATA(^TMP(RESULT,$JOB,WVCOUNT,"PREGNANCY END DATE"))=0
DO SETARRAY(,"P2",0)
QUIT
+104 IF $DATA(^TMP(RESULT,$JOB,WVCOUNT,"PREGNANCY END DATE"))=1
IF $DATA(^TMP(RESULT,$JOB,WVCOUNT,"REASON PREGNANCY ENDED"))'=1
DO SETARRAY(,"P2",0)
QUIT
+105 DO SETARRAY(,"P2",1)
End DoDot:4
+106 if $PIECE(^TMP(RESULT,$JOB,WVCOUNT,"MEDICALLY UNABLE TO CONCEIVE"),U)=1
QUIT
+107 IF WVSTATUS=""
DO SETARRAY(,"P2",0)
+108 IF '$DATA(^TMP(RESULT,$JOB,WVCOUNT,"DOCUMENTATION STATUS"))
DO SETARRAY(,"P2",1)
End DoDot:3
+109 IF WVTYPE="L"
Begin DoDot:3
+110 IF $PIECE($GET(^TMP(RESULT,$JOB,WVCOUNT,"LACTATION STATE")),U)=0&('$DATA(^TMP(RESULT,$JOB,WVCOUNT,"END DATE")))&($PIECE($GET(^WV(790,WVDFN,WVSUB,0)),U,4)>1)
Begin DoDot:4
+111 NEW WVPIEN
+112 SET WVPIEN=+$ORDER(WVINDEX(WVDATE),-1)
IF WVPIEN>0
SET WVPIEN=+$ORDER(WVINDEX(WVPIEN,0))
+113 IF WVPIEN>0
IF $PIECE($GET(^WV(790,WVDFN,WVSUB,WVPIEN,2)),U)=1
DO SETARRAY(,"P2",0)
QUIT
+114 DO SETARRAY(,"P2",1)
End DoDot:4
QUIT
+115 DO SETARRAY(,"P2",1)
End DoDot:3
End DoDot:2
End DoDot:1
+116 SET ^TMP(RESULT,$JOB)=WVCOUNT
+117 QUIT
+118 ;
PFIELDS ;PSEUDO-FIELD DEFINITIONS
+1 ;;PREGNANCY LIKELIHOOD^S $P(WVDATA,U,2)=$S(WVDATA=1:"HIGH",WVDATA=2:"LOW",WVDATA=-1:"CALCULATION ERROR",1:"UNKNOWN")
+2 ;;DOCUMENTATION STATUS^S $P(WVDATA,U,2)=$S(WVDATA=0:"INCOMPLETE",WVDATA=1:"COMPLETE",1:"UNKNOWN")
SAVEDATA(WVRETURN,WVDATA) ;SAVE DATA FROM CLINICAL REMINDERS
+1 ; INPUT: WVRETURN - REFERENCE TO ARRAY IN WHICH TO RETURN STATUS
+2 ; [REQUIRED]
+3 ; WVDATA - REFERENCE TO ARRAY OF DATA TO SAVE
+4 ; [REQUIRED]
+5 NEW WVFILE
+6 SET WVFILE=0
FOR
SET WVFILE=$ORDER(WVDATA("DATA",WVFILE))
if WVFILE=""!(+$GET(WVRETURN(1))<0)
QUIT
Begin DoDot:1
+7 IF "^790^790.05^790.17^790.16^790.9^790.1^790.4^790.23^"'[(U_WVFILE_U)
SET WVRETURN(1)=-1_U_"Invalid file number: "_WVFILE
End DoDot:1
+8 if $DATA(WVRETURN)
QUIT
+9 IF $GET(WVDATA("DFN"))'?1.N
Begin DoDot:1
+10 SET WVRETURN(1)=-1_U_"Invalid patient identifier: "_$GET(WVDATA("DFN"),"No identifer specified.")
End DoDot:1
QUIT
+11 NEW WVNPFLAG
+12 SET WVNPFLAG=$$ISREG^WVUTL11(WVDATA("DFN"))
+13 IF '+WVNPFLAG
SET WVRETURN(1)=-1_U_$PIECE(WVNPFLAG,U,2)
QUIT
+14 IF $DATA(WVDATA("DATA",790))
Begin DoDot:1
+15 NEW WVID
+16 SET WVID=$ORDER(WVDATA("DATA",790,""))
if WVID=""
QUIT
+17 IF WVID["+"
MERGE WVDATA("DATA",790,WVDATA("DFN")_",")=WVDATA("DATA",790,WVID)
KILL WVDATA("DATA",790,WVID)
End DoDot:1
+18 IF $DATA(WVDATA("DATA",790))!($DATA(WVDATA("DATA",790.1)))!($DATA(WVDATA("DATA",790.4)))!($DATA(WVDATA("DATA",790.23)))
DO NEW^WVRPCGF(.WVRETURN,.WVDATA)
+19 IF $DATA(WVDATA("DATA",790.9))
SET WVRETURN(1)=$$CLRSRND^WVRPCPT2(WVDATA("DFN"),$EXTRACT(WVDATA("DATA",790.9,$ORDER(WVDATA("DATA",790.9,"")),.01),*))
+20 if +$GET(WVRETURN(1))=-1
QUIT
+21 NEW WVERROR,WVCMNEW,WVIEN,WVNEWREC,WVREC,WVFIELD,WVVPR
+22 NEW WVFDA,WVARRAY,WVCMIEN,WV79005NR,WVENTRY,WVVIEN,WVSEQ
+23 IF $GET(WVDATA("VISIT"))=""
SET WVVIEN=0
+24 IF '$TEST
Begin DoDot:1
+25 SET WVVIEN=$$VISITIEN^WVUTL11(WVDATA("DFN"),$GET(WVDATA("VISIT")))
+26 IF WVVIEN<1
Begin DoDot:2
+27 FOR WVFILE=790.05,790.16
Begin DoDot:3
+28 if '$DATA(WVDATA("DATA",WVFILE))
QUIT
+29 IF $GET(WVDATA("DATA",WVFILE,"MASTER ID"))=""
Begin DoDot:4
+30 SET WVRETURN(1)=-1_U_"Invalid VISIT file entry specified: "_$GET(WVDATA("VISIT"))
End DoDot:4
QUIT
End DoDot:3
if +$GET(WVRETURN(1))<0
QUIT
End DoDot:2
End DoDot:1
if +$GET(WVRETURN(1))=-1
QUIT
+31 DO CHKIENS(.WVDATA)
+32 DO EXTRTDAT^WVRPCVPR(+$$GETLREC^WVUTL11(WVDATA("DFN"),4)_","_WVDATA("DFN")_",","BEFORE")
+33 ;Ensure records are complete and then save data (contraceptive methods handled separately)
+34 SET WVFILE=0
FOR
SET WVFILE=$ORDER(WVDATA("DATA",WVFILE))
if 'WVFILE!(+$GET(WVRETURN(1))<0)
QUIT
Begin DoDot:1
+35 IF "^790^790.1^790.4^790.9^790.23^"[(U_WVFILE_U)
QUIT
+36 SET WVARRAY=$SELECT(WVFILE=790.17:"WVCMNEW",1:"WVFDA")
+37 SET WVREC=""
FOR
SET WVREC=$ORDER(WVDATA("DATA",WVFILE,WVREC))
if 'WVREC!($PIECE($GET(WVRETURN(1)),U)=-1)
QUIT
Begin DoDot:2
+38 SET WVNEWREC=$SELECT($EXTRACT(WVREC,1)="+":1,1:0)
SET WVENTRY=""
+39 IF WVFILE=790.17
IF WVREC["?"
SET WVENTRY=$PIECE(WVREC,"?")_WVCMIEN_","_$PIECE($PIECE(WVREC,"?",2),",",2,$LENGTH($PIECE(WVREC,"?",2),","))
+40 MERGE @WVARRAY@(WVFILE,$SELECT(WVENTRY'="":WVENTRY,1:WVREC))=WVDATA("DATA",WVFILE,WVREC)
+41 if '$DATA(WVFDA)
QUIT
+42 IF WVNEWREC
IF $DATA(WVFDA(WVFILE,WVREC))
IF '$DATA(WVFDA(WVFILE,WVREC,.01))
SET WVFDA(WVFILE,WVREC,.01)=$$NOW^XLFDT
+43 IF WVVIEN>0
IF '$DATA(WVFDA(WVFILE,WVREC,4))
SET WVFDA(WVFILE,WVREC,4)="`"_WVVIEN
+44 IF $GET(WVDATA("DOCUMENT"))>0
SET WVFDA(WVFILE,WVREC,5)="`"_WVDATA("DOCUMENT")
+45 DO VALENTRY(WVFILE,WVREC,.WVFDA,WVNEWREC)
+46 if $GET(WVNEWREC)
DO UPDATE^DIE("E","WVFDA","WVIEN","WVERROR")
+47 if '$GET(WVNEWREC)
DO FILE^DIE("EK","WVFDA","WVERROR")
+48 IF WVFILE=790.05
Begin DoDot:3
+49 IF WVNEWREC
SET WVSEQ=$PIECE($PIECE(WVREC,",",1),"+",2)
SET WVCMIEN=$GET(WVIEN(WVSEQ))
+50 IF '$TEST
SET WVCMIEN=$PIECE(WVREC,",")
+51 SET WVCMIEN(1)=$PIECE(WVREC,",",2)
SET WV79005NR=WVNEWREC
+52 SET WVVPR("AFTER")=$SELECT(WVNEWREC:$GET(WVIEN(WVSEQ))_","_WVDATA("DFN")_",",1:WVREC)
End DoDot:3
+53 IF $DATA(WVERROR)
SET WVRETURN(1)=-1_U_"Unable to save/update the status data: "_$$FMERROR^WVUTL11(.WVERROR)
End DoDot:2
End DoDot:1
+54 if +$GET(WVRETURN(1))=-1
QUIT
+55 IF $DATA(WVDATA("DATA",790.05))!($DATA(WVDATA("DATA",790.17)))
Begin DoDot:1
+56 SET WVRETURN(1)=$$METHOD^WVTDALRT(WVDATA("DFN"),.WVCMIEN,+$GET(WV79005NR),.WVCMNEW)
+57 DO NOTIFY^WVRPCVPR(.WVVPR)
End DoDot:1
+58 IF '$DATA(WVRETURN(1))
SET WVRETURN(1)=1
+59 QUIT
+60 ;
VALENTRY(WVFILE,WVENTRY,WVFDA,WVNEWREC) ;VALIDATE THE DATA TO FILE
+1 ;INPUT: WVFILE - FILE NUMBER IN WHICH DATA WILL BE SAVED [REQUIRED]
+2 ; WVENTRY - FILEMAN IENS VALUE OF THE ENTRY IN THE FILE [REQUIRED]
+3 ; WVFDA - REFERENCE TO ARRAY CONTAINING THE NEW ENTRY
+4 ;WIPE OUT LATER FIELDS IF MUC REASON IS SET
IF $DATA(WVFDA(WVFILE,WVENTRY,23))
KILL WVFDA(WVFILE,WVENTRY,24)
+5 NEW WVFIELD,WVVALUE
+6 ;HANDLE BLANK FIELD VALUES
+7 SET WVFIELD=""
FOR
SET WVFIELD=$ORDER(WVFDA(WVFILE,WVENTRY,WVFIELD))
if WVFIELD=""
QUIT
Begin DoDot:1
+8 SET WVVALUE=$GET(WVFDA(WVFILE,WVENTRY,WVFIELD))
if WVVALUE'=""
QUIT
+9 IF WVNEWREC
KILL WVFDA(WVFILE,WVENTRY,WVFIELD)
+10 IF 'WVNEWREC
SET WVFDA(WVFILE,WVENTRY,WVFIELD)="@"
End DoDot:1
+11 QUIT
+12 ;
CHKIENS(WVDATA) ;ENSURE IENS ARE COMPLETE AND ACCURATE
+1 ;INPUT: WVDATA - REFERENCE TO ARRAY CONTAINING DATA TO CHECK
+2 NEW WVLEVELS,WVLEVEL,WVIEN,WVFILE,WVMIENS,WVIENS,WVENTRY,WVUPLVL,WVPFILE,WVPLCHDR,WVID,WVSTRIP,WVNEWPH,WVPDIENS
+3 ;WVLEVELS(LEVEL_#,FILE_#)=PARENT_FILE_#
+4 SET WVLEVELS(1,790)=""
SET WVLEVELS(2,790.05)=790
SET WVLEVELS(2,790.16)=790
SET WVLEVELS(3,790.17)=790.05
+5 SET WVLEVELS(1,790.1)=""
SET WVLEVELS(2,790.23)=790.1
SET WVLEVELS(1,790.4)=""
+6 SET WVSTRIP("+")="?"
+7 SET WVIEN(790)=$GET(WVDATA("DFN"))
+8 SET WVLEVEL=0
FOR
SET WVLEVEL=$ORDER(WVLEVELS(WVLEVEL))
if '+WVLEVEL
QUIT
Begin DoDot:1
+9 SET WVFILE=0
FOR
SET WVFILE=$ORDER(WVLEVELS(WVLEVEL,WVFILE))
if '+WVFILE
QUIT
Begin DoDot:2
+10 if '$DATA(WVDATA("DATA",WVFILE))
QUIT
+11 KILL WVPDIENS
+12 SET WVMIENS=$PIECE($GET(WVDATA("DATA",WVFILE,"MASTER ID")),":")
SET WVNEWPH=0
+13 SET WVIENS=""
FOR
SET WVIENS=$ORDER(WVDATA("DATA",WVFILE,WVIENS))
if WVIENS=""
QUIT
Begin DoDot:3
+14 IF (WVIENS="MASTER ID")!($DATA(WVPDIENS(WVIENS)))
QUIT
+15 IF $EXTRACT(WVIENS,1)="+"
Begin DoDot:4
+16 SET WVID=$EXTRACT(WVIENS,2,$LENGTH($PIECE(WVIENS,",")))
+17 IF $DATA(WVPLCHDR(WVID))
SET WVPLCHDR=WVPLCHDR+1
SET WVPLCHDR(WVPLCHDR)=""
SET WVNEWPH=1
+18 IF '$TEST
SET WVPLCHDR(WVID)=""
SET WVPLCHDR=WVID
End DoDot:4
+19 SET WVIEN(WVFILE)=$SELECT(WVNEWPH:"+"_WVPLCHDR,1:$PIECE(WVIENS,","))
+20 IF $LENGTH(WVIENS,",")<(WVLEVEL+1)
Begin DoDot:4
+21 SET WVENTRY=WVIEN(WVFILE)_","
+22 SET WVUPLVL=WVLEVEL+1
SET WVPFILE=WVFILE
FOR
SET WVUPLVL=$ORDER(WVLEVELS(WVUPLVL),-1)
if '+WVUPLVL
QUIT
SET WVPFILE=WVLEVELS(WVUPLVL,WVPFILE)
IF WVPFILE'=""
SET WVENTRY=WVENTRY_WVIEN(WVPFILE)_","
+23 SET $PIECE(WVENTRY,",",2,$LENGTH(WVENTRY,","))=$$REPLACE^XLFSTR($PIECE(WVENTRY,",",2,$LENGTH(WVENTRY,",")),.WVSTRIP)
+24 MERGE WVDATA("DATA",WVFILE,WVENTRY)=WVDATA("DATA",WVFILE,WVIENS)
+25 KILL WVDATA("DATA",WVFILE,WVIENS)
+26 SET WVIENS=""
SET WVPDIENS(WVENTRY)=""
End DoDot:4
+27 IF WVIENS'=""
SET WVPDIENS(WVIENS)=""
End DoDot:3
+28 IF WVMIENS'=""
KILL WVDATA("DATA",WVFILE,"MASTER ID")
End DoDot:2
End DoDot:1
+29 QUIT
SETARRAY(WVFILE,WVFIELD,WVDATA,WVMSUB) ;SET DATA INTO THE RETURN ARRAY
+1 ; INPUT: WVFILE - FILE NUMBER CONTAINING THE FIELD [REQUIRED]
+2 ; WVFIELD - FIELD NUMBER [REQUIRED]
+3 ; WVDATA - INTERNAL VALUE OF THE FIELD [REQUIRED]
+4 ; WVMSUB - SUBSCRIPT WITHIN THE TMP GLOBAL TO RETURN DATA IN
+5 NEW WVSUB
+6 IF $EXTRACT(WVFIELD,1)="P"
Begin DoDot:1
+7 NEW WVCODE,WVLINE
+8 SET WVLINE=$EXTRACT(WVFIELD,2,*)
+9 SET WVSUB=$PIECE($PIECE($TEXT(PFIELDS+WVLINE),";;",2),U)
+10 SET WVCODE=$PIECE($PIECE($TEXT(PFIELDS+WVLINE),";;",2),U,2)
+11 if WVCODE'=""
XECUTE WVCODE
End DoDot:1
+12 IF $EXTRACT(WVFIELD,1)'="P"
Begin DoDot:1
+13 SET WVSUB=$$GET1^DID(WVFILE,WVFIELD,,"LABEL")
+14 SET $PIECE(WVDATA,U,2)=$$EXTERNAL^DILFD(WVFILE,WVFIELD,"",WVDATA)
End DoDot:1
+15 IF $GET(WVMSUB)>0
SET ^TMP(RESULT,$JOB,WVCOUNT,WVSUB,WVMSUB)=WVDATA
+16 IF '$TEST
SET ^TMP(RESULT,$JOB,WVCOUNT,WVSUB)=WVDATA
+17 QUIT
+18 ;
GETSTATUS(WVDFN) ;RETURN SINGLE LINE PREGNANT/LACTATING
+1 NEW WVPOST,WVINDEX,WVRET,WVTEXT,WVSUB
+2 DO POSTLIST^WVRPCOR(.WVPOST,WVDFN,.WVINDEX)
+3 SET WVINDEX=0
FOR
SET WVINDEX=$ORDER(WVPOST(WVINDEX))
if WVINDEX=""
QUIT
Begin DoDot:1
+4 SET WVTEXT=$PIECE(WVPOST(WVINDEX),U,2)
+5 SET WVRET=$SELECT($GET(WVRET)'="":WVRET_" and ",1:"")_WVTEXT
+6 IF WVTEXT'="Pregnant"
QUIT
+7 SET WVSUB(1)=$$GETSUB^WVRPCOR(WVDFN)
+8 SET WVSUB(2)=$PIECE($PIECE($GET(^XTMP(WVSUB(1),"POSTINGS","P")),";",2),",",1)
+9 IF WVSUB(2)=""
QUIT
+10 SET WVRET=WVRET_" (Expected Due Date: "_$$FMTE^XLFDT($PIECE($GET(^WV(790,WVDFN,4,WVSUB(2),4)),U,2))_")"
End DoDot:1
+11 QUIT $GET(WVRET)
GETEDD(WVDFN) ;RETURN EDD AND WEEKS GESTATION
+1 NEW WVREC,WVEDD,WVGA,WVRESULT,WVSTATUS
+2 SET WVRESULT=$NAME(^TMP("WVEDD",$JOB))
+3 SET WVREC=$$GETLREC^WVUTL11(WVDFN,4)
+4 SET WVSTATUS=$PIECE($GET(^WV(790,WVDFN,4,+WVREC,2)),U,1)
+5 IF WVSTATUS'=1
SET @WVRESULT@(1,0)=""
QUIT "~@"_WVRESULT
+6 SET WVEDD=$PIECE($GET(^WV(790,WVDFN,4,+WVREC,4)),U,2)
+7 SET @WVRESULT@(1,0)="Expected Due Date: "_$$FMTE^XLFDT(WVEDD)
+8 SET WVGA=$PIECE(((280-$$FMDIFF^XLFDT(WVEDD,DT,1))/7),".",1)
+9 IF $PIECE(WVREC,U,4)=1
SET @WVRESULT@(2,0)="Gestational Age: "_WVGA_" weeks"
+10 QUIT "~@"_WVRESULT
