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

WVRPCVPR.m

Go to the documentation of this file.
  1. WVRPCVPR ;ISP/RFR - DATA EXTRACT TO VPR ;Oct 19, 2020@14:47
  1. ;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
  1. Q
  1. BASELINE(DFN) ;RETURNS A BASELINE PREGNANCY STATUS FOR THE SPECIFIED PATIENT IN THE PACKAGE
  1. I '$D(^WV(790,DFN)) D Q
  1. .K ^TMP("WVPREGST",$J)
  1. .S ^TMP("WVPREGST",$J,"ERROR")="THE SPECIFIED PATIENT IS NOT IN THE WOMEN'S HEALTH PACKAGE."
  1. .S ^TMP("WVPREGST",$J,"ERROR","RECORD ID")=DFN_","
  1. N IEN
  1. S IEN=+$$GETLREC^WVUTL11(DFN,4) Q:'IEN
  1. D EXTRTDAT(IEN_","_DFN_",","BASELINE")
  1. Q
  1. EXTRTDAT(DAS,TMPNODE) ;COPY DATA INTO ^TMP GLOBAL
  1. N DFN,IEN,NODE0,NODE2,NODE4,STATE,STATUS,COMM,REMINDER,DISPLAY,MESSAGE
  1. N OUTPUT
  1. S IEN=$P(DAS,","),DFN=$P(DAS,",",2),TMPNODE=$G(TMPNODE)
  1. I 'IEN!(TMPNODE="") Q
  1. S NODE0=$G(^WV(790,DFN,4,IEN,0)),NODE2=$G(^WV(790,DFN,4,IEN,2))
  1. S NODE4=$G(^WV(790,DFN,4,IEN,4))
  1. S REMINDER="VA-WH UPDATE PREGNANCY STATUS"
  1. S OUTPUT=$NA(^TMP("WVPREGST",$J,TMPNODE))
  1. K @OUTPUT
  1. S @OUTPUT@("EXTERNAL ID")=DAS
  1. ;ENTERED IN ERROR
  1. S @OUTPUT@("ENTERED IN ERROR")=+$P(NODE0,U,6)
  1. I $P(NODE0,U,6) D
  1. .S STATUS="INACTIVE"
  1. .N EIEN
  1. .S EIEN=0 F S EIEN=$O(^WV(790,DFN,4,IEN,1,EIEN)) Q:'+EIEN D
  1. ..S COMM=$S($G(COMM)'="":COMM_" ",1:"")_$$TRIM^XLFSTR($G(^WV(790,DFN,4,IEN,1,EIEN,0)))
  1. .S COMM="REASON ENTERED IN ERROR: "_$G(COMM)
  1. ;STATE
  1. I $P(NODE2,U,2)=1 D
  1. .S STATE="-1"_U_"UNABLE TO CONCEIVE"
  1. .S COMM=$S($G(COMM)'="":COMM_"; ",1:"")_"REASON UNABLE TO MEDICALLY CONCEIVE: "_$P(NODE2,U,3)
  1. E S STATE=$P(NODE2,U)_U_$$EXTERNAL^DILFD(790.05,21,"",$P(NODE2,U),"MESSAGE")
  1. I $D(MESSAGE) D Q
  1. .S ^TMP("WVPREGST",$J,"ERROR")=$$FMERROR^WVUTL11(.MESSAGE)
  1. .S ^TMP("WVPREGST",$J,"ERROR","RECORD ID")=DAS
  1. S @OUTPUT@("STATE")=STATE
  1. S @OUTPUT@("ENCOUNTER NUMBER")=$P(NODE0,U,4)
  1. S @OUTPUT@("ENTERED BY")=$P(NODE0,U,2)
  1. S @OUTPUT@("ENTERED ON")=$P(NODE0,U)
  1. ;STATUS
  1. I ((TMPNODE="BEFORE")!(TMPNODE="BASELINE")),'$P(NODE0,U,6) D
  1. .N PARAM,RESULT,FIEVAL
  1. .S PARAM("SUB")="WVVPR",PARAM("DFN")=DFN
  1. .S PARAM("REMINDERS",REMINDER)=1_U_5_U
  1. .D EN^PXRMGEV(.RESULT,.PARAM)
  1. .I $P($G(^TMP($J,"WVVPR",REMINDER)),U)["DUE" D
  1. ..S FIEVAL=$NA(^TMP($J,"WVVPR",REMINDER,"FIEVAL"))
  1. ..I $G(@FIEVAL@(3)) D
  1. ...I $G(@FIEVAL@(3,"DOCUMENTATION STATUS"))="INCOMPLETE",$G(@FIEVAL@(3,"PREGNANCY DATA SOURCE"))="ORDER ENTRY/RESULTS REPORTING" D
  1. ....S STATUS="ACTIVE"
  1. ...E S STATUS="INACTIVE"
  1. ..I '$G(@FIEVAL@(3)) D
  1. ...S STATUS="INACTIVE"
  1. .I $P($G(^TMP($J,"WVVPR",REMINDER)),U)'["DUE" D
  1. ..S STATUS="ACTIVE"
  1. .K ^TMP($J,"WVVPR")
  1. I TMPNODE="AFTER" S STATUS="ACTIVE"
  1. S @OUTPUT@("STATUS")=STATUS
  1. ;FROM TIME/TO TIME
  1. I +$P(STATE,U)=1 D
  1. .S @OUTPUT@("FROM TIME")=$S($P(NODE4,U)="":$P($P(NODE0,U),"."),1:$P(NODE4,U))
  1. .S @OUTPUT@("TO TIME")=$P(NODE4,U,2)
  1. .I $P(NODE4,U,3)'="" S COMM=$S($G(COMM)'="":COMM_"; ",1:"")_"EDD CHANGE: "_$P(NODE4,U,3)
  1. I +$P(STATE,U)'=1 D
  1. .I +$P(NODE4,U,4)>0 D
  1. ..S @OUTPUT@("FROM TIME")=$P(NODE4,U,4)
  1. ..S @OUTPUT@("TO TIME")=DT
  1. ..S COMM=$S($G(COMM)'="":COMM_"; ",1:"")_"REASON PREGNANCY ENDED: "_$P(NODE4,U,5)
  1. .I '+$P(NODE4,U,4) D
  1. ..S @OUTPUT@("FROM TIME")=$P($P(NODE0,U),".")
  1. ..S @OUTPUT@("TO TIME")=DT
  1. I $G(COMM)'="" S @OUTPUT@("COMMENTS")=COMM
  1. Q
  1. NOTIFY(DAS) ;NOTIFY SUBSCRIBING PACKAGES OF NEW OR CHANGED DATA
  1. N DIC,X,SUB
  1. F SUB="BEFORE","AFTER" I $D(DAS(SUB)) D EXTRTDAT(DAS(SUB),SUB)
  1. I $D(^TMP("WVPREGST",$J)) D
  1. .S DIC=101,X="WV PREGNANCY STATUS CHANGE EVENT"
  1. .D EN^XQOR
  1. .K ^TMP("WVPREGST",$J)
  1. Q