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