- 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 Jan 18, 2025@03:48:51 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