WVRPCPT.m

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 ---WVRPCPT   15526     printed  Mar 13, 2025@21:52:46                                                                                                                                                                                                    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)