- 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 Feb 19, 2025@00:14:18 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