WVRPCOR2 ;ISP/RFR - CPRS RPCS CONTINUED ;Oct 19, 2020@14:42
;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
Q
SAVEDATA(WVRETURN,WVDATA) ;SAVE DATA FROM COVER SHEET
;RPC: WVRPCOR SAVEDATA
N WVLNCNT,WVDEF,WVIEN,WVNODE,WVFILE,WVPKG,WVTYPES,WVEXTERNAL,WVERROR,WVNPFLAG
N WVVPR
;Convert WVDATA(1..n)="name=value" to WVDATA("name")=value
D CLEAN(.WVDATA)
I $G(WVDATA("PATIENT"))'?1.N D ERROR(.WVRETURN,"ROOT") Q
S WVNPFLAG=$$ISREG^WVUTL11(WVDATA("PATIENT"))
I '+WVNPFLAG S WVRETURN=-1_U_$P(WVNPFLAG,U,2) Q
S WVPKG=+$$FIND1^DIC(9.4,,,"ORDER ENTRY/RESULTS REPORTING",,,"WVERROR")
I $D(WVERROR) S WVRETURN=-1_U_$$FMERROR^WVUTL11(.WVERROR)
I WVPKG<1 S WVRETURN=-1_U_"Cannot find the ORDER ENTRY/RESULTS REPORTING software package in the PACKAGE file." Q
S WVVPR("BEFORE")=+$$GETLREC^WVUTL11(WVDATA("PATIENT"),4)_","_WVDATA("PATIENT")_","
D SETUP^WVRPCOR
S WVRETURN=1_U
S WVNODE=0 F S WVNODE=$O(WVTYPES(WVNODE)) Q:'+WVNODE!(+WVRETURN=-1) D
.N WVFDA,WVNOSAVE,WVAPPL
.S WVIEN="+1,"_WVDATA("PATIENT")_",",WVFILE=$P(WVTYPES(WVNODE),U,2),WVNOSAVE=0
.F WVLNCNT=2:1 S WVDEF=$P($T(SUBS+WVLNCNT),";;",2) Q:WVDEF="EOF"!(+WVRETURN=-1)!(WVNOSAVE) D
..I '(($P(WVDEF,U,2)=WVNODE)!($P(WVDEF,U,2)="*")) Q
..I $P(WVDEF,U,4)'="" X $P(WVDEF,U,4,$L(WVDEF,U)) Q:+WVRETURN=-1!(WVNOSAVE)
..I $G(WVDATA($P(WVDEF,U)))'="" S WVFDA(WVFILE,WVIEN,$P(WVDEF,U,3))=WVDATA($P(WVDEF,U))
.I WVNOSAVE S WVRETURN=-1_U_"Your data was not saved. Please contact the help desk for assistance."
.Q:+WVRETURN=-1!('$D(WVFDA))
.S WVFDA(WVFILE,WVIEN,.01)=$$NOW^XLFDT,WVFDA($P(WVTYPES(WVNODE),U,2),WVIEN,3)="`"_WVPKG
.K WVIEN
.D UPDATE^DIE("E","WVFDA","WVIEN","WVERROR")
.I $D(WVERROR) S WVRETURN=-1_U_$$FMERROR^WVUTL11(.WVERROR)
.I '$D(WVERROR),WVNODE=4 S WVVPR("AFTER")=+$G(WVIEN(1))_","_WVDATA("PATIENT")_","
D NOTIFY^WVRPCVPR(.WVVPR)
Q
SUBS ;NAMES OF SUBSCRIPTS THAT SHOULD BE IN THE DATA ARRAY
;FORMAT: SUBSCRIPT NAME ^ SUB-SCRIPT NUMBER IN ^WV(790,D0, ^ FIELD NUMBER ^ SAVE CONVERSION/VALIDATION CODE
;;ABLE TO CONCEIVE^4^22^D VMAC
;;PREGNANCY STATUS^4^21^D VPREG
;;MEDICAL REASON^4^23^I $G(WVDATA("MEDICAL REASON"))'="",$G(WVDATA("PREGNANCY STATUS"))'="" D ERROR(.WVRETURN,13) Q
;;LAST MENSTRUAL PERIOD DATE^4^41^D VLMP
;;EXPECTED DUE DATE^4^42^D VEDD
;;LACTATION STATUS^5^21^D VLAC
;;EOF
Q
ERROR(WVRETURN,WVERRNUM) ;POPULATE THE RETURN ARRAY WITH AN ERROR MESSAGE
N WVTYPE
S WVRETURN=-1
I $G(WVNODE)'="" S WVTYPE=$P(WVTYPES(WVNODE),U,3)
I WVERRNUM="ROOT" D
.S $P(WVRETURN,U,2)="Invalid patient specified."
I WVERRNUM=6 D
.S $P(WVRETURN,U,2)="Medical reason is required when the medically able to conceive value is No."
I WVERRNUM=7 D
.S $P(WVRETURN,U,2)="Invalid medically able to conceive value specified: "_$G(WVDATA("ABLE TO CONCEIVE"))_"."
I WVERRNUM=8 D
.S $P(WVRETURN,U,2)="Medically able to conceive is required."
I WVERRNUM=9 D
.S $P(WVRETURN,U,2)="Invalid "_$$LOW^XLFSTR($G(WVTYPE))_" status specified: "_$G(WVDATA($G(WVTYPE)_" STATUS"))_"."
I WVERRNUM=10 D
.S $P(WVRETURN,U,2)="Pregnancy status is required when the patient is medically able to conceive."
I WVERRNUM=13 D
.S $P(WVRETURN,U,2)="Do not enter a currently pregnant value when the patient is medically unable to conceive."
I WVERRNUM=14 D
.S $P(WVRETURN,U,2)="Only enter the last menstrual period value when the currently pregnant value is Yes."
I WVERRNUM=16 D
.S $P(WVRETURN,U,2)="Only enter the expected due date value when the currently pregnant value is Yes."
Q
VMAC ;VALIDATE/CONVERT MEDICALLY ABLE TO CONCEIVE
S WVAPPL=$$APPL^WVRPCOR(WVDATA("PATIENT"),WVNODE)
Q:'$D(WVDATA("ABLE TO CONCEIVE"))
N WVSTATUS
S WVSTATUS=$$UP^XLFSTR($G(WVDATA("ABLE TO CONCEIVE"))),WVSTATUS=$S($E(WVSTATUS,1)="Y":"NO",$E(WVSTATUS,1)="N":"YES",1:"")
I WVSTATUS="" D ERROR(.WVRETURN,7) Q
I WVSTATUS="YES",$G(WVDATA("MEDICAL REASON"))="" D ERROR(.WVRETURN,6) Q
S WVDATA("ABLE TO CONCEIVE")=WVSTATUS
Q
VPREG ;VALIDATE/CONVERT PREGNANCY STATUS
Q:'$D(WVDATA("PREGNANCY STATUS"))
I $G(WVDATA("ABLE TO CONCEIVE"))="" D ERROR(.WVRETURN,8) Q
N WVSTATUS,WVEXIT
S WVSTATUS=$$UP^XLFSTR($G(WVDATA("PREGNANCY STATUS")))
I WVSTATUS="" D Q:+WVRETURN=-1!($G(WVEXIT))
.I $G(WVDATA("ABLE TO CONCEIVE"))="NO" D ERROR(.WVRETURN,10) Q
.I $G(WVDATA("ABLE TO CONCEIVE"))="YES" D Q
..S WVEXIT=1
..I $D(WVDATA("PREGNANCY STATUS")) K WVDATA("PREGNANCY STATUS")
S WVSTATUS=$S($E(WVSTATUS,1)="Y":"PREGNANT",$E(WVSTATUS,1)="N":"NOT PREGNANT",$E(WVSTATUS,1)="U":"DO NOT KNOW",1:"")
I WVSTATUS="" D ERROR(.WVRETURN,9) Q
I WVSTATUS="PREGNANT" S WVFDA(WVFILE,WVIEN,22)="NO"
S WVDATA("PREGNANCY STATUS")=WVSTATUS
Q
VLMP ;VALIDATE LAST MENSTRUAL PERIOD DATE
Q:'$D(WVDATA("LAST MENSTRUAL PERIOD DATE"))
I $G(WVDATA("LAST MENSTRUAL PERIOD DATE"))>0,$$UP^XLFSTR($G(WVDATA("PREGNANCY STATUS")))'="PREGNANT" D ERROR(.WVRETURN,14) Q
I $$UP^XLFSTR($G(WVDATA("PREGNANCY STATUS")))="PREGNANT" D
.N WVFDA,WVSTAT
.S WVFDA("DATA",790.05,"+1,"_WVDATA("PATIENT")_",",$P(WVDEF,U,3))=WVDATA("LAST MENSTRUAL PERIOD DATE")
.D VERDATA^WVRPCPT2(.WVSTAT,.WVFDA)
.I WVSTAT(0)=-1 S WVRETURN=-1_U_WVSTAT(1)
Q
VEDD ;VALIDATE EXPECTED DUE DATE
I $G(WVDATA("EXPECTED DUE DATE"))>0,$$UP^XLFSTR($G(WVDATA("PREGNANCY STATUS")))'="PREGNANT" D ERROR(.WVRETURN,16) Q
I $$UP^XLFSTR($G(WVDATA("PREGNANCY STATUS")))="PREGNANT" D
.N WVFDA,WVSTAT
.S WVFDA("DATA",790.05,"+1,"_WVDATA("PATIENT")_",",$P(WVDEF,U,3))=WVDATA("EXPECTED DUE DATE")
.D VERDATA^WVRPCPT2(.WVSTAT,.WVFDA)
.I WVSTAT(0)=-1 S WVRETURN=-1_U_WVSTAT(1)
Q
VLAC ;VALIDATE LACTATION STATUS
Q:'$D(WVDATA("LACTATION STATUS"))
N WVSTATUS
S WVSTATUS=$$UP^XLFSTR($G(WVDATA("LACTATION STATUS")))
S WVSTATUS=$S($E(WVSTATUS,1)="Y":"LACTATING",$E(WVSTATUS,1)="N":"NOT LACTATING",1:"")
I WVSTATUS="" D ERROR(.WVRETURN,9) Q
S WVDATA("LACTATION STATUS")=WVSTATUS
Q
CLEAN(WVARRAY) ;UNMANGLE NAME=VALUE PAIRS ARRAY
N X
S X=0 F S X=$O(WVARRAY(X)) Q:'X S WVARRAY($P(WVARRAY(X),"="))=$P(WVARRAY(X),"=",2,250) K WVARRAY(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPCOR2 6044 printed Sep 23, 2025@20:24:02 Page 2
WVRPCOR2 ;ISP/RFR - CPRS RPCS CONTINUED ;Oct 19, 2020@14:42
+1 ;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
+2 QUIT
SAVEDATA(WVRETURN,WVDATA) ;SAVE DATA FROM COVER SHEET
+1 ;RPC: WVRPCOR SAVEDATA
+2 NEW WVLNCNT,WVDEF,WVIEN,WVNODE,WVFILE,WVPKG,WVTYPES,WVEXTERNAL,WVERROR,WVNPFLAG
+3 NEW WVVPR
+4 ;Convert WVDATA(1..n)="name=value" to WVDATA("name")=value
+5 DO CLEAN(.WVDATA)
+6 IF $GET(WVDATA("PATIENT"))'?1.N
DO ERROR(.WVRETURN,"ROOT")
QUIT
+7 SET WVNPFLAG=$$ISREG^WVUTL11(WVDATA("PATIENT"))
+8 IF '+WVNPFLAG
SET WVRETURN=-1_U_$PIECE(WVNPFLAG,U,2)
QUIT
+9 SET WVPKG=+$$FIND1^DIC(9.4,,,"ORDER ENTRY/RESULTS REPORTING",,,"WVERROR")
+10 IF $DATA(WVERROR)
SET WVRETURN=-1_U_$$FMERROR^WVUTL11(.WVERROR)
+11 IF WVPKG<1
SET WVRETURN=-1_U_"Cannot find the ORDER ENTRY/RESULTS REPORTING software package in the PACKAGE file."
QUIT
+12 SET WVVPR("BEFORE")=+$$GETLREC^WVUTL11(WVDATA("PATIENT"),4)_","_WVDATA("PATIENT")_","
+13 DO SETUP^WVRPCOR
+14 SET WVRETURN=1_U
+15 SET WVNODE=0
FOR
SET WVNODE=$ORDER(WVTYPES(WVNODE))
if '+WVNODE!(+WVRETURN=-1)
QUIT
Begin DoDot:1
+16 NEW WVFDA,WVNOSAVE,WVAPPL
+17 SET WVIEN="+1,"_WVDATA("PATIENT")_","
SET WVFILE=$PIECE(WVTYPES(WVNODE),U,2)
SET WVNOSAVE=0
+18 FOR WVLNCNT=2:1
SET WVDEF=$PIECE($TEXT(SUBS+WVLNCNT),";;",2)
if WVDEF="EOF"!(+WVRETURN=-1)!(WVNOSAVE)
QUIT
Begin DoDot:2
+19 IF '(($PIECE(WVDEF,U,2)=WVNODE)!($PIECE(WVDEF,U,2)="*"))
QUIT
+20 IF $PIECE(WVDEF,U,4)'=""
XECUTE $PIECE(WVDEF,U,4,$LENGTH(WVDEF,U))
if +WVRETURN=-1!(WVNOSAVE)
QUIT
+21 IF $GET(WVDATA($PIECE(WVDEF,U)))'=""
SET WVFDA(WVFILE,WVIEN,$PIECE(WVDEF,U,3))=WVDATA($PIECE(WVDEF,U))
End DoDot:2
+22 IF WVNOSAVE
SET WVRETURN=-1_U_"Your data was not saved. Please contact the help desk for assistance."
+23 if +WVRETURN=-1!('$DATA(WVFDA))
QUIT
+24 SET WVFDA(WVFILE,WVIEN,.01)=$$NOW^XLFDT
SET WVFDA($PIECE(WVTYPES(WVNODE),U,2),WVIEN,3)="`"_WVPKG
+25 KILL WVIEN
+26 DO UPDATE^DIE("E","WVFDA","WVIEN","WVERROR")
+27 IF $DATA(WVERROR)
SET WVRETURN=-1_U_$$FMERROR^WVUTL11(.WVERROR)
+28 IF '$DATA(WVERROR)
IF WVNODE=4
SET WVVPR("AFTER")=+$GET(WVIEN(1))_","_WVDATA("PATIENT")_","
End DoDot:1
+29 DO NOTIFY^WVRPCVPR(.WVVPR)
+30 QUIT
SUBS ;NAMES OF SUBSCRIPTS THAT SHOULD BE IN THE DATA ARRAY
+1 ;FORMAT: SUBSCRIPT NAME ^ SUB-SCRIPT NUMBER IN ^WV(790,D0, ^ FIELD NUMBER ^ SAVE CONVERSION/VALIDATION CODE
+2 ;;ABLE TO CONCEIVE^4^22^D VMAC
+3 ;;PREGNANCY STATUS^4^21^D VPREG
+4 ;;MEDICAL REASON^4^23^I $G(WVDATA("MEDICAL REASON"))'="",$G(WVDATA("PREGNANCY STATUS"))'="" D ERROR(.WVRETURN,13) Q
+5 ;;LAST MENSTRUAL PERIOD DATE^4^41^D VLMP
+6 ;;EXPECTED DUE DATE^4^42^D VEDD
+7 ;;LACTATION STATUS^5^21^D VLAC
+8 ;;EOF
+9 QUIT
ERROR(WVRETURN,WVERRNUM) ;POPULATE THE RETURN ARRAY WITH AN ERROR MESSAGE
+1 NEW WVTYPE
+2 SET WVRETURN=-1
+3 IF $GET(WVNODE)'=""
SET WVTYPE=$PIECE(WVTYPES(WVNODE),U,3)
+4 IF WVERRNUM="ROOT"
Begin DoDot:1
+5 SET $PIECE(WVRETURN,U,2)="Invalid patient specified."
End DoDot:1
+6 IF WVERRNUM=6
Begin DoDot:1
+7 SET $PIECE(WVRETURN,U,2)="Medical reason is required when the medically able to conceive value is No."
End DoDot:1
+8 IF WVERRNUM=7
Begin DoDot:1
+9 SET $PIECE(WVRETURN,U,2)="Invalid medically able to conceive value specified: "_$GET(WVDATA("ABLE TO CONCEIVE"))_"."
End DoDot:1
+10 IF WVERRNUM=8
Begin DoDot:1
+11 SET $PIECE(WVRETURN,U,2)="Medically able to conceive is required."
End DoDot:1
+12 IF WVERRNUM=9
Begin DoDot:1
+13 SET $PIECE(WVRETURN,U,2)="Invalid "_$$LOW^XLFSTR($GET(WVTYPE))_" status specified: "_$GET(WVDATA($GET(WVTYPE)_" STATUS"))_"."
End DoDot:1
+14 IF WVERRNUM=10
Begin DoDot:1
+15 SET $PIECE(WVRETURN,U,2)="Pregnancy status is required when the patient is medically able to conceive."
End DoDot:1
+16 IF WVERRNUM=13
Begin DoDot:1
+17 SET $PIECE(WVRETURN,U,2)="Do not enter a currently pregnant value when the patient is medically unable to conceive."
End DoDot:1
+18 IF WVERRNUM=14
Begin DoDot:1
+19 SET $PIECE(WVRETURN,U,2)="Only enter the last menstrual period value when the currently pregnant value is Yes."
End DoDot:1
+20 IF WVERRNUM=16
Begin DoDot:1
+21 SET $PIECE(WVRETURN,U,2)="Only enter the expected due date value when the currently pregnant value is Yes."
End DoDot:1
+22 QUIT
VMAC ;VALIDATE/CONVERT MEDICALLY ABLE TO CONCEIVE
+1 SET WVAPPL=$$APPL^WVRPCOR(WVDATA("PATIENT"),WVNODE)
+2 if '$DATA(WVDATA("ABLE TO CONCEIVE"))
QUIT
+3 NEW WVSTATUS
+4 SET WVSTATUS=$$UP^XLFSTR($GET(WVDATA("ABLE TO CONCEIVE")))
SET WVSTATUS=$SELECT($EXTRACT(WVSTATUS,1)="Y":"NO",$EXTRACT(WVSTATUS,1)="N":"YES",1:"")
+5 IF WVSTATUS=""
DO ERROR(.WVRETURN,7)
QUIT
+6 IF WVSTATUS="YES"
IF $GET(WVDATA("MEDICAL REASON"))=""
DO ERROR(.WVRETURN,6)
QUIT
+7 SET WVDATA("ABLE TO CONCEIVE")=WVSTATUS
+8 QUIT
VPREG ;VALIDATE/CONVERT PREGNANCY STATUS
+1 if '$DATA(WVDATA("PREGNANCY STATUS"))
QUIT
+2 IF $GET(WVDATA("ABLE TO CONCEIVE"))=""
DO ERROR(.WVRETURN,8)
QUIT
+3 NEW WVSTATUS,WVEXIT
+4 SET WVSTATUS=$$UP^XLFSTR($GET(WVDATA("PREGNANCY STATUS")))
+5 IF WVSTATUS=""
Begin DoDot:1
+6 IF $GET(WVDATA("ABLE TO CONCEIVE"))="NO"
DO ERROR(.WVRETURN,10)
QUIT
+7 IF $GET(WVDATA("ABLE TO CONCEIVE"))="YES"
Begin DoDot:2
+8 SET WVEXIT=1
+9 IF $DATA(WVDATA("PREGNANCY STATUS"))
KILL WVDATA("PREGNANCY STATUS")
End DoDot:2
QUIT
End DoDot:1
if +WVRETURN=-1!($GET(WVEXIT))
QUIT
+10 SET WVSTATUS=$SELECT($EXTRACT(WVSTATUS,1)="Y":"PREGNANT",$EXTRACT(WVSTATUS,1)="N":"NOT PREGNANT",$EXTRACT(WVSTATUS,1)="U":"DO NOT KNOW",1:"")
+11 IF WVSTATUS=""
DO ERROR(.WVRETURN,9)
QUIT
+12 IF WVSTATUS="PREGNANT"
SET WVFDA(WVFILE,WVIEN,22)="NO"
+13 SET WVDATA("PREGNANCY STATUS")=WVSTATUS
+14 QUIT
VLMP ;VALIDATE LAST MENSTRUAL PERIOD DATE
+1 if '$DATA(WVDATA("LAST MENSTRUAL PERIOD DATE"))
QUIT
+2 IF $GET(WVDATA("LAST MENSTRUAL PERIOD DATE"))>0
IF $$UP^XLFSTR($GET(WVDATA("PREGNANCY STATUS")))'="PREGNANT"
DO ERROR(.WVRETURN,14)
QUIT
+3 IF $$UP^XLFSTR($GET(WVDATA("PREGNANCY STATUS")))="PREGNANT"
Begin DoDot:1
+4 NEW WVFDA,WVSTAT
+5 SET WVFDA("DATA",790.05,"+1,"_WVDATA("PATIENT")_",",$PIECE(WVDEF,U,3))=WVDATA("LAST MENSTRUAL PERIOD DATE")
+6 DO VERDATA^WVRPCPT2(.WVSTAT,.WVFDA)
+7 IF WVSTAT(0)=-1
SET WVRETURN=-1_U_WVSTAT(1)
End DoDot:1
+8 QUIT
VEDD ;VALIDATE EXPECTED DUE DATE
+1 IF $GET(WVDATA("EXPECTED DUE DATE"))>0
IF $$UP^XLFSTR($GET(WVDATA("PREGNANCY STATUS")))'="PREGNANT"
DO ERROR(.WVRETURN,16)
QUIT
+2 IF $$UP^XLFSTR($GET(WVDATA("PREGNANCY STATUS")))="PREGNANT"
Begin DoDot:1
+3 NEW WVFDA,WVSTAT
+4 SET WVFDA("DATA",790.05,"+1,"_WVDATA("PATIENT")_",",$PIECE(WVDEF,U,3))=WVDATA("EXPECTED DUE DATE")
+5 DO VERDATA^WVRPCPT2(.WVSTAT,.WVFDA)
+6 IF WVSTAT(0)=-1
SET WVRETURN=-1_U_WVSTAT(1)
End DoDot:1
+7 QUIT
VLAC ;VALIDATE LACTATION STATUS
+1 if '$DATA(WVDATA("LACTATION STATUS"))
QUIT
+2 NEW WVSTATUS
+3 SET WVSTATUS=$$UP^XLFSTR($GET(WVDATA("LACTATION STATUS")))
+4 SET WVSTATUS=$SELECT($EXTRACT(WVSTATUS,1)="Y":"LACTATING",$EXTRACT(WVSTATUS,1)="N":"NOT LACTATING",1:"")
+5 IF WVSTATUS=""
DO ERROR(.WVRETURN,9)
QUIT
+6 SET WVDATA("LACTATION STATUS")=WVSTATUS
+7 QUIT
CLEAN(WVARRAY) ;UNMANGLE NAME=VALUE PAIRS ARRAY
+1 NEW X
+2 SET X=0
FOR
SET X=$ORDER(WVARRAY(X))
if 'X
QUIT
SET WVARRAY($PIECE(WVARRAY(X),"="))=$PIECE(WVARRAY(X),"=",2,250)
KILL WVARRAY(X)
+3 QUIT
