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

WVRPCOR2.m

Go to the documentation of this file.
  1. WVRPCOR2 ;ISP/RFR - CPRS RPCS CONTINUED ;Oct 19, 2020@14:42
  1. ;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
  1. Q
  1. SAVEDATA(WVRETURN,WVDATA) ;SAVE DATA FROM COVER SHEET
  1. ;RPC: WVRPCOR SAVEDATA
  1. N WVLNCNT,WVDEF,WVIEN,WVNODE,WVFILE,WVPKG,WVTYPES,WVEXTERNAL,WVERROR,WVNPFLAG
  1. N WVVPR
  1. ;Convert WVDATA(1..n)="name=value" to WVDATA("name")=value
  1. D CLEAN(.WVDATA)
  1. I $G(WVDATA("PATIENT"))'?1.N D ERROR(.WVRETURN,"ROOT") Q
  1. S WVNPFLAG=$$ISREG^WVUTL11(WVDATA("PATIENT"))
  1. I '+WVNPFLAG S WVRETURN=-1_U_$P(WVNPFLAG,U,2) Q
  1. S WVPKG=+$$FIND1^DIC(9.4,,,"ORDER ENTRY/RESULTS REPORTING",,,"WVERROR")
  1. I $D(WVERROR) S WVRETURN=-1_U_$$FMERROR^WVUTL11(.WVERROR)
  1. I WVPKG<1 S WVRETURN=-1_U_"Cannot find the ORDER ENTRY/RESULTS REPORTING software package in the PACKAGE file." Q
  1. S WVVPR("BEFORE")=+$$GETLREC^WVUTL11(WVDATA("PATIENT"),4)_","_WVDATA("PATIENT")_","
  1. D SETUP^WVRPCOR
  1. S WVRETURN=1_U
  1. S WVNODE=0 F S WVNODE=$O(WVTYPES(WVNODE)) Q:'+WVNODE!(+WVRETURN=-1) D
  1. .N WVFDA,WVNOSAVE,WVAPPL
  1. .S WVIEN="+1,"_WVDATA("PATIENT")_",",WVFILE=$P(WVTYPES(WVNODE),U,2),WVNOSAVE=0
  1. .F WVLNCNT=2:1 S WVDEF=$P($T(SUBS+WVLNCNT),";;",2) Q:WVDEF="EOF"!(+WVRETURN=-1)!(WVNOSAVE) D
  1. ..I '(($P(WVDEF,U,2)=WVNODE)!($P(WVDEF,U,2)="*")) Q
  1. ..I $P(WVDEF,U,4)'="" X $P(WVDEF,U,4,$L(WVDEF,U)) Q:+WVRETURN=-1!(WVNOSAVE)
  1. ..I $G(WVDATA($P(WVDEF,U)))'="" S WVFDA(WVFILE,WVIEN,$P(WVDEF,U,3))=WVDATA($P(WVDEF,U))
  1. .I WVNOSAVE S WVRETURN=-1_U_"Your data was not saved. Please contact the help desk for assistance."
  1. .Q:+WVRETURN=-1!('$D(WVFDA))
  1. .S WVFDA(WVFILE,WVIEN,.01)=$$NOW^XLFDT,WVFDA($P(WVTYPES(WVNODE),U,2),WVIEN,3)="`"_WVPKG
  1. .K WVIEN
  1. .D UPDATE^DIE("E","WVFDA","WVIEN","WVERROR")
  1. .I $D(WVERROR) S WVRETURN=-1_U_$$FMERROR^WVUTL11(.WVERROR)
  1. .I '$D(WVERROR),WVNODE=4 S WVVPR("AFTER")=+$G(WVIEN(1))_","_WVDATA("PATIENT")_","
  1. D NOTIFY^WVRPCVPR(.WVVPR)
  1. Q
  1. 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
  1. ;;ABLE TO CONCEIVE^4^22^D VMAC
  1. ;;PREGNANCY STATUS^4^21^D VPREG
  1. ;;MEDICAL REASON^4^23^I $G(WVDATA("MEDICAL REASON"))'="",$G(WVDATA("PREGNANCY STATUS"))'="" D ERROR(.WVRETURN,13) Q
  1. ;;LAST MENSTRUAL PERIOD DATE^4^41^D VLMP
  1. ;;EXPECTED DUE DATE^4^42^D VEDD
  1. ;;LACTATION STATUS^5^21^D VLAC
  1. ;;EOF
  1. Q
  1. ERROR(WVRETURN,WVERRNUM) ;POPULATE THE RETURN ARRAY WITH AN ERROR MESSAGE
  1. N WVTYPE
  1. S WVRETURN=-1
  1. I $G(WVNODE)'="" S WVTYPE=$P(WVTYPES(WVNODE),U,3)
  1. I WVERRNUM="ROOT" D
  1. .S $P(WVRETURN,U,2)="Invalid patient specified."
  1. I WVERRNUM=6 D
  1. .S $P(WVRETURN,U,2)="Medical reason is required when the medically able to conceive value is No."
  1. I WVERRNUM=7 D
  1. .S $P(WVRETURN,U,2)="Invalid medically able to conceive value specified: "_$G(WVDATA("ABLE TO CONCEIVE"))_"."
  1. I WVERRNUM=8 D
  1. .S $P(WVRETURN,U,2)="Medically able to conceive is required."
  1. I WVERRNUM=9 D
  1. .S $P(WVRETURN,U,2)="Invalid "_$$LOW^XLFSTR($G(WVTYPE))_" status specified: "_$G(WVDATA($G(WVTYPE)_" STATUS"))_"."
  1. I WVERRNUM=10 D
  1. .S $P(WVRETURN,U,2)="Pregnancy status is required when the patient is medically able to conceive."
  1. I WVERRNUM=13 D
  1. .S $P(WVRETURN,U,2)="Do not enter a currently pregnant value when the patient is medically unable to conceive."
  1. I WVERRNUM=14 D
  1. .S $P(WVRETURN,U,2)="Only enter the last menstrual period value when the currently pregnant value is Yes."
  1. I WVERRNUM=16 D
  1. .S $P(WVRETURN,U,2)="Only enter the expected due date value when the currently pregnant value is Yes."
  1. Q
  1. VMAC ;VALIDATE/CONVERT MEDICALLY ABLE TO CONCEIVE
  1. S WVAPPL=$$APPL^WVRPCOR(WVDATA("PATIENT"),WVNODE)
  1. Q:'$D(WVDATA("ABLE TO CONCEIVE"))
  1. N WVSTATUS
  1. S WVSTATUS=$$UP^XLFSTR($G(WVDATA("ABLE TO CONCEIVE"))),WVSTATUS=$S($E(WVSTATUS,1)="Y":"NO",$E(WVSTATUS,1)="N":"YES",1:"")
  1. I WVSTATUS="" D ERROR(.WVRETURN,7) Q
  1. I WVSTATUS="YES",$G(WVDATA("MEDICAL REASON"))="" D ERROR(.WVRETURN,6) Q
  1. S WVDATA("ABLE TO CONCEIVE")=WVSTATUS
  1. Q
  1. VPREG ;VALIDATE/CONVERT PREGNANCY STATUS
  1. Q:'$D(WVDATA("PREGNANCY STATUS"))
  1. I $G(WVDATA("ABLE TO CONCEIVE"))="" D ERROR(.WVRETURN,8) Q
  1. N WVSTATUS,WVEXIT
  1. S WVSTATUS=$$UP^XLFSTR($G(WVDATA("PREGNANCY STATUS")))
  1. I WVSTATUS="" D Q:+WVRETURN=-1!($G(WVEXIT))
  1. .I $G(WVDATA("ABLE TO CONCEIVE"))="NO" D ERROR(.WVRETURN,10) Q
  1. .I $G(WVDATA("ABLE TO CONCEIVE"))="YES" D Q
  1. ..S WVEXIT=1
  1. ..I $D(WVDATA("PREGNANCY STATUS")) K WVDATA("PREGNANCY STATUS")
  1. S WVSTATUS=$S($E(WVSTATUS,1)="Y":"PREGNANT",$E(WVSTATUS,1)="N":"NOT PREGNANT",$E(WVSTATUS,1)="U":"DO NOT KNOW",1:"")
  1. I WVSTATUS="" D ERROR(.WVRETURN,9) Q
  1. I WVSTATUS="PREGNANT" S WVFDA(WVFILE,WVIEN,22)="NO"
  1. S WVDATA("PREGNANCY STATUS")=WVSTATUS
  1. Q
  1. VLMP ;VALIDATE LAST MENSTRUAL PERIOD DATE
  1. Q:'$D(WVDATA("LAST MENSTRUAL PERIOD DATE"))
  1. I $G(WVDATA("LAST MENSTRUAL PERIOD DATE"))>0,$$UP^XLFSTR($G(WVDATA("PREGNANCY STATUS")))'="PREGNANT" D ERROR(.WVRETURN,14) Q
  1. I $$UP^XLFSTR($G(WVDATA("PREGNANCY STATUS")))="PREGNANT" D
  1. .N WVFDA,WVSTAT
  1. .S WVFDA("DATA",790.05,"+1,"_WVDATA("PATIENT")_",",$P(WVDEF,U,3))=WVDATA("LAST MENSTRUAL PERIOD DATE")
  1. .D VERDATA^WVRPCPT2(.WVSTAT,.WVFDA)
  1. .I WVSTAT(0)=-1 S WVRETURN=-1_U_WVSTAT(1)
  1. Q
  1. VEDD ;VALIDATE EXPECTED DUE DATE
  1. I $G(WVDATA("EXPECTED DUE DATE"))>0,$$UP^XLFSTR($G(WVDATA("PREGNANCY STATUS")))'="PREGNANT" D ERROR(.WVRETURN,16) Q
  1. I $$UP^XLFSTR($G(WVDATA("PREGNANCY STATUS")))="PREGNANT" D
  1. .N WVFDA,WVSTAT
  1. .S WVFDA("DATA",790.05,"+1,"_WVDATA("PATIENT")_",",$P(WVDEF,U,3))=WVDATA("EXPECTED DUE DATE")
  1. .D VERDATA^WVRPCPT2(.WVSTAT,.WVFDA)
  1. .I WVSTAT(0)=-1 S WVRETURN=-1_U_WVSTAT(1)
  1. Q
  1. VLAC ;VALIDATE LACTATION STATUS
  1. Q:'$D(WVDATA("LACTATION STATUS"))
  1. N WVSTATUS
  1. S WVSTATUS=$$UP^XLFSTR($G(WVDATA("LACTATION STATUS")))
  1. S WVSTATUS=$S($E(WVSTATUS,1)="Y":"LACTATING",$E(WVSTATUS,1)="N":"NOT LACTATING",1:"")
  1. I WVSTATUS="" D ERROR(.WVRETURN,9) Q
  1. S WVDATA("LACTATION STATUS")=WVSTATUS
  1. Q
  1. CLEAN(WVARRAY) ;UNMANGLE NAME=VALUE PAIRS ARRAY
  1. N X
  1. S X=0 F S X=$O(WVARRAY(X)) Q:'X S WVARRAY($P(WVARRAY(X),"="))=$P(WVARRAY(X),"=",2,250) K WVARRAY(X)
  1. Q