WVRPCVPR ;ISP/RFR - DATA EXTRACT TO VPR ;Oct 19, 2020@14:47
;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
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^WVUTL11(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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPCVPR 3418 printed Sep 23, 2025@20:24:09 Page 2
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
+2 QUIT
BASELINE(DFN) ;RETURNS A BASELINE PREGNANCY STATUS FOR THE SPECIFIED PATIENT IN THE PACKAGE
+1 IF '$DATA(^WV(790,DFN))
Begin DoDot:1
+2 KILL ^TMP("WVPREGST",$JOB)
+3 SET ^TMP("WVPREGST",$JOB,"ERROR")="THE SPECIFIED PATIENT IS NOT IN THE WOMEN'S HEALTH PACKAGE."
+4 SET ^TMP("WVPREGST",$JOB,"ERROR","RECORD ID")=DFN_","
End DoDot:1
QUIT
+5 NEW IEN
+6 SET IEN=+$$GETLREC^WVUTL11(DFN,4)
if 'IEN
QUIT
+7 DO EXTRTDAT(IEN_","_DFN_",","BASELINE")
+8 QUIT
EXTRTDAT(DAS,TMPNODE) ;COPY DATA INTO ^TMP GLOBAL
+1 NEW DFN,IEN,NODE0,NODE2,NODE4,STATE,STATUS,COMM,REMINDER,DISPLAY,MESSAGE
+2 NEW OUTPUT
+3 SET IEN=$PIECE(DAS,",")
SET DFN=$PIECE(DAS,",",2)
SET TMPNODE=$GET(TMPNODE)
+4 IF 'IEN!(TMPNODE="")
QUIT
+5 SET NODE0=$GET(^WV(790,DFN,4,IEN,0))
SET NODE2=$GET(^WV(790,DFN,4,IEN,2))
+6 SET NODE4=$GET(^WV(790,DFN,4,IEN,4))
+7 SET REMINDER="VA-WH UPDATE PREGNANCY STATUS"
+8 SET OUTPUT=$NAME(^TMP("WVPREGST",$JOB,TMPNODE))
+9 KILL @OUTPUT
+10 SET @OUTPUT@("EXTERNAL ID")=DAS
+11 ;ENTERED IN ERROR
+12 SET @OUTPUT@("ENTERED IN ERROR")=+$PIECE(NODE0,U,6)
+13 IF $PIECE(NODE0,U,6)
Begin DoDot:1
+14 SET STATUS="INACTIVE"
+15 NEW EIEN
+16 SET EIEN=0
FOR
SET EIEN=$ORDER(^WV(790,DFN,4,IEN,1,EIEN))
if '+EIEN
QUIT
Begin DoDot:2
+17 SET COMM=$SELECT($GET(COMM)'="":COMM_" ",1:"")_$$TRIM^XLFSTR($GET(^WV(790,DFN,4,IEN,1,EIEN,0)))
End DoDot:2
+18 SET COMM="REASON ENTERED IN ERROR: "_$GET(COMM)
End DoDot:1
+19 ;STATE
+20 IF $PIECE(NODE2,U,2)=1
Begin DoDot:1
+21 SET STATE="-1"_U_"UNABLE TO CONCEIVE"
+22 SET COMM=$SELECT($GET(COMM)'="":COMM_"; ",1:"")_"REASON UNABLE TO MEDICALLY CONCEIVE: "_$PIECE(NODE2,U,3)
End DoDot:1
+23 IF '$TEST
SET STATE=$PIECE(NODE2,U)_U_$$EXTERNAL^DILFD(790.05,21,"",$PIECE(NODE2,U),"MESSAGE")
+24 IF $DATA(MESSAGE)
Begin DoDot:1
+25 SET ^TMP("WVPREGST",$JOB,"ERROR")=$$FMERROR^WVUTL11(.MESSAGE)
+26 SET ^TMP("WVPREGST",$JOB,"ERROR","RECORD ID")=DAS
End DoDot:1
QUIT
+27 SET @OUTPUT@("STATE")=STATE
+28 SET @OUTPUT@("ENCOUNTER NUMBER")=$PIECE(NODE0,U,4)
+29 SET @OUTPUT@("ENTERED BY")=$PIECE(NODE0,U,2)
+30 SET @OUTPUT@("ENTERED ON")=$PIECE(NODE0,U)
+31 ;STATUS
+32 IF ((TMPNODE="BEFORE")!(TMPNODE="BASELINE"))
IF '$PIECE(NODE0,U,6)
Begin DoDot:1
+33 NEW PARAM,RESULT,FIEVAL
+34 SET PARAM("SUB")="WVVPR"
SET PARAM("DFN")=DFN
+35 SET PARAM("REMINDERS",REMINDER)=1_U_5_U
+36 DO EN^PXRMGEV(.RESULT,.PARAM)
+37 IF $PIECE($GET(^TMP($JOB,"WVVPR",REMINDER)),U)["DUE"
Begin DoDot:2
+38 SET FIEVAL=$NAME(^TMP($JOB,"WVVPR",REMINDER,"FIEVAL"))
+39 IF $GET(@FIEVAL@(3))
Begin DoDot:3
+40 IF $GET(@FIEVAL@(3,"DOCUMENTATION STATUS"))="INCOMPLETE"
IF $GET(@FIEVAL@(3,"PREGNANCY DATA SOURCE"))="ORDER ENTRY/RESULTS REPORTING"
Begin DoDot:4
+41 SET STATUS="ACTIVE"
End DoDot:4
+42 IF '$TEST
SET STATUS="INACTIVE"
End DoDot:3
+43 IF '$GET(@FIEVAL@(3))
Begin DoDot:3
+44 SET STATUS="INACTIVE"
End DoDot:3
End DoDot:2
+45 IF $PIECE($GET(^TMP($JOB,"WVVPR",REMINDER)),U)'["DUE"
Begin DoDot:2
+46 SET STATUS="ACTIVE"
End DoDot:2
+47 KILL ^TMP($JOB,"WVVPR")
End DoDot:1
+48 IF TMPNODE="AFTER"
SET STATUS="ACTIVE"
+49 SET @OUTPUT@("STATUS")=STATUS
+50 ;FROM TIME/TO TIME
+51 IF +$PIECE(STATE,U)=1
Begin DoDot:1
+52 SET @OUTPUT@("FROM TIME")=$SELECT($PIECE(NODE4,U)="":$PIECE($PIECE(NODE0,U),"."),1:$PIECE(NODE4,U))
+53 SET @OUTPUT@("TO TIME")=$PIECE(NODE4,U,2)
+54 IF $PIECE(NODE4,U,3)'=""
SET COMM=$SELECT($GET(COMM)'="":COMM_"; ",1:"")_"EDD CHANGE: "_$PIECE(NODE4,U,3)
End DoDot:1
+55 IF +$PIECE(STATE,U)'=1
Begin DoDot:1
+56 IF +$PIECE(NODE4,U,4)>0
Begin DoDot:2
+57 SET @OUTPUT@("FROM TIME")=$PIECE(NODE4,U,4)
+58 SET @OUTPUT@("TO TIME")=DT
+59 SET COMM=$SELECT($GET(COMM)'="":COMM_"; ",1:"")_"REASON PREGNANCY ENDED: "_$PIECE(NODE4,U,5)
End DoDot:2
+60 IF '+$PIECE(NODE4,U,4)
Begin DoDot:2
+61 SET @OUTPUT@("FROM TIME")=$PIECE($PIECE(NODE0,U),".")
+62 SET @OUTPUT@("TO TIME")=DT
End DoDot:2
End DoDot:1
+63 IF $GET(COMM)'=""
SET @OUTPUT@("COMMENTS")=COMM
+64 QUIT
NOTIFY(DAS) ;NOTIFY SUBSCRIBING PACKAGES OF NEW OR CHANGED DATA
+1 NEW DIC,X,SUB
+2 FOR SUB="BEFORE","AFTER"
IF $DATA(DAS(SUB))
DO EXTRTDAT(DAS(SUB),SUB)
+3 IF $DATA(^TMP("WVPREGST",$JOB))
Begin DoDot:1
+4 SET DIC=101
SET X="WV PREGNANCY STATUS CHANGE EVENT"
+5 DO EN^XQOR
+6 KILL ^TMP("WVPREGST",$JOB)
End DoDot:1
+7 QUIT
