PXRMCWH1 ;ISP/RFR - COMPUTED FINDINGS FOR TERATOGENIC DRUGS;Dec 17, 2020@14:27
;;2.0;CLINICAL REMINDERS;**45,71**;Feb 4, 2005;Build 43
Q
DEFGRACE() ;Return default grace period when none is specified
Q "4W"
DOCSTAT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
;documentation on file
N WHTYPE,WHSDIR,IDX,ELEMENTS,ELEMENT,WHGRACE,WHDOCDT,SOURCE
S WHSDIR=$S($G(NGET)<0:1,1:-1)
S NGET=$S($G(NGET)<0:-NGET,1:$G(NGET))
S TEST=$S($G(TEST)'="":$$UP^XLFSTR(TEST),1:"PREGNANCIES")
S WHTYPE("PREGNANCIES")="P"_U_"Pregnancy"_U_"pregnancy"_U_"PREGNANCY STATE"_U_"PREGNANCY STATUS"
S WHTYPE("LACTATIONS")="L"_U_"Lactation"_U_"lactation"_U_"LACTATION STATE"_U_"LACTATION STATUS"
I $P(TEST,U,2)="DATA" S DATA(1,"DIALOG")=1,DATA(1,"PACKAGE")="WOMEN'S HEALTH",DATA(1,"PACKAGE PREFIX")="WV"
S WHGRACE=$$GETGRACE(TEST)
S TEST=$P(TEST,U)
S WHTYPE=$P(WHTYPE(TEST),U)
S ELEMENTS("DOCUMENTATION STATUS")=2
S ELEMENTS($P(WHTYPE(TEST),U,4))=2
I TEST="PREGNANCIES" D
.S ELEMENTS("MEDICALLY UNABLE TO CONCEIVE")=2
.S ELEMENTS("MEDICAL REASON")=1
.S ELEMENTS("TRYING TO BECOME PREGNANT")=2
.S ELEMENTS("CONTRACEPTIVE METHOD USED")=2
.S ELEMENTS("LAST MENSTRUAL PERIOD DATE")=1
.S ELEMENTS("EDD")=1
.S ELEMENTS("PREGNANCY END DATE")=1
.S ELEMENTS("PREGNANCY LIKELIHOOD")=2
.S ELEMENTS("REASON PREGNANCY ENDED")=1
.S ELEMENTS("OVERRIDE CALCULATED EDD REASON")=1
I TEST="LACTATIONS" D
.S ELEMENTS("END DATE")=1
S DATE(1)=$P($$NOW^PXRMDATE,"."),TEST(1)=1
S TEXT(1)=$S($G(DATA(1,"DIALOG"))=1:" ",1:"")_"No documented "_$P(WHTYPE(TEST),U,3)_" status."
D GETDATA^WVRPCPT("PXRMWHDATA",DFN,WHTYPE,$G(BDT),$G(EDT),NGET,WHSDIR,DATE(1))
F IDX=1:1:$G(^TMP("PXRMWHDATA",$J)) D
.S TEST(IDX)=1,DATA(IDX,"DATE/TIME")=$P($G(^TMP("PXRMWHDATA",$J,IDX,$P(WHTYPE(TEST),U,5)_" D/T ENTERED")),U)
.S DATE(IDX)=$P(DATA(IDX,"DATE/TIME"),".")
.S WHDOCDT=$P($G(^TMP("PXRMWHDATA",$J,IDX,$P(WHTYPE(TEST),U,5)_" D/T ENTERED")),U,2)
.S DATA(IDX,$$UP^XLFSTR($P(WHTYPE(TEST),U,2))_" DAS")=$G(^TMP("PXRMWHDATA",$J,IDX,"RECORD ID"))
.S DATA(IDX,$$UP^XLFSTR($P(WHTYPE(TEST),U,2))_" DATA SOURCE")=$P($G(^TMP("PXRMWHDATA",$J,IDX,"DATA SOURCE")),U,2)
.S DATA(IDX,"VISIT")=$G(^TMP("PXRMWHDATA",$J,IDX,"VISIT STRING"))
.S ELEMENT="" F S ELEMENT=$O(ELEMENTS(ELEMENT)) Q:ELEMENT="" D
..I $D(^TMP("PXRMWHDATA",$J,IDX,ELEMENT))>9 D Q
...S ELEMENT(1)=0 F S ELEMENT(1)=$O(^TMP("PXRMWHDATA",$J,IDX,ELEMENT,ELEMENT(1))) Q:'ELEMENT(1) D
....S DATA(IDX,ELEMENT,ELEMENT(1))=$P($G(^TMP("PXRMWHDATA",$J,IDX,ELEMENT,ELEMENT(1))),U,ELEMENTS(ELEMENT))
..I $D(^TMP("PXRMWHDATA",$J,IDX,ELEMENT))=1 D
...S DATA(IDX,ELEMENT)=$P($G(^TMP("PXRMWHDATA",$J,IDX,ELEMENT)),U,ELEMENTS(ELEMENT))
...I ELEMENT="EDD" D
....S DATA(IDX,(ELEMENT_"-GRACE"))=$$NEWDATE^PXRMDATE($G(DATA(IDX,ELEMENT)),"+",WHGRACE)
....S DATA(IDX,"TWENTY-EIGHT WEEKS' GESTATION")=$$NEWDATE^PXRMDATE($G(DATA(IDX,ELEMENT)),"-","12W")
.I $P($G(^TMP("PXRMWHDATA",$J,IDX,"MEDICALLY UNABLE TO CONCEIVE")),U) D
..S TEXT(IDX)="Medically unable to conceive "
..N SUBTEXT S SUBTEXT=$P($G(^TMP("PXRMWHDATA",$J,IDX,"MEDICAL REASON")),U,ELEMENTS("MEDICAL REASON"))
..I SUBTEXT'="" S TEXT(IDX)=TEXT(IDX)_"("_SUBTEXT_") "
..S TEXT(IDX)=TEXT(IDX)_"documented on "_WHDOCDT
.E S TEXT(IDX)=$P(WHTYPE(TEST),U,2)_" status "_$G(DATA(IDX,$P(WHTYPE(TEST),U,4)))_" documented on "_WHDOCDT
.I $G(DATA(IDX,"DOCUMENTATION STATUS"))="INCOMPLETE" D
..I $G(DATA(IDX,$$UP^XLFSTR($P(WHTYPE(TEST),U,2))_" DATA SOURCE"))="ORDER ENTRY/RESULTS REPORTING" D
...S SOURCE="on the Cover Sheet"
..E S SOURCE="via the "_$$TITLE^XLFSTR($G(DATA(IDX,$$UP^XLFSTR($P(WHTYPE(TEST),U,2))_" DATA SOURCE")))_" software package"
..S TEXT(IDX)=TEXT(IDX)_" was entered "_SOURCE_" but the clinical reminder dialog was not completed"
.S TEXT(IDX)=TEXT(IDX)_"."
.I $P($G(^TMP("PXRMWHDATA",$J,IDX,$P(WHTYPE(TEST),U,4))),U)=1,TEST="PREGNANCIES" D
..S TEXT(IDX)=TEXT(IDX)_"\\LAST MENSTRUAL PERIOD: "_$P($G(^TMP("PXRMWHDATA",$J,IDX,"LAST MENSTRUAL PERIOD DATE")),U,2)
..I $P($G(^TMP("PXRMWHDATA",$J,IDX,"PREGNANCY END DATE")),U)>0 D
...S TEXT(IDX)=TEXT(IDX)_"\\PREGNANCY ENDED: "_$P($G(^TMP("PXRMWHDATA",$J,IDX,"PREGNANCY END DATE")),U,2)
..E S TEXT(IDX)=TEXT(IDX)_"\\EDD: "_$P($G(^TMP("PXRMWHDATA",$J,IDX,"EDD")),U,2)
.I $P($G(^TMP("PXRMWHDATA",$J,IDX,$P(WHTYPE(TEST),U,4))),U)=0,TEST="LACTATIONS",$P($G(^TMP("PXRMWHDATA",$J,IDX,"END DATE")),U)>0 D
..S TEXT(IDX)=TEXT(IDX)_"\\END DATE: "_$P($G(^TMP("PXRMWHDATA",$J,IDX,"END DATE")),U,2)
.I $G(DATA(1,"DIALOG"))=1 S TEXT(IDX)=" "_TEXT(IDX)
I +$G(^TMP("PXRMWHDATA",$J))<0 D
.S TEXT(1)=$S($G(DATA(1,"DIALOG"))=1:" ",1:"")_"Unable to retrieve documentation due to a Women's Health package "
.S TEXT(1)=TEXT(1)_"error; "_$P(^TMP("PXRMWHDATA",$J),U,2)
.S DATA(1,"DOCUMENTATION STATUS")="NO DOCUMENTATION"
I +$G(^TMP("PXRMWHDATA",$J))=0 D
.S DATA(1,"DOCUMENTATION STATUS")="NO DOCUMENTATION"
S NFOUND=$S(+$G(^TMP("PXRMWHDATA",$J))>0:+$G(^TMP("PXRMWHDATA",$J)),1:1)
K ^TMP("PXRMWHDATA",$J)
Q
GETGRACE(TEST) ;Return the EDD grace period
S TEST=$G(TEST)
Q $S($P(TEST,U,3)'="":$P(TEST,U,3),1:$$DEFGRACE)
GETGRACD() ;Return number of days in the EDD grace period
N CFIEN,RDIEN,PERIOD,CDT
S CFIEN=+$O(^PXRMD(811.4,"B","VA-WH PATIENT DOCUMENTATION",0)) Q:'CFIEN 0
S CFIEN=CFIEN_";PXRMD(811.4,"
S RDIEN=+$O(^PXD(811.9,"B","VA-WH UPDATE PREGNANCY STATUS",0)) Q:'RDIEN 0
S CFIEN("SUB")=+$O(^PXD(811.9,RDIEN,20,"B",CFIEN,0)) Q:'CFIEN("SUB") 0
S PERIOD=$$GETGRACE($G(^PXD(811.9,RDIEN,20,CFIEN("SUB"),15)))
S CDT=$$NEWDATE^PXRMDATE(DT,"+",PERIOD)
Q $$FMDIFF^XLFDT(CDT,DT)
ORDERCNT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
;number of unsafe orders returned by GETORDRS^WVRPCPT1 (TIU object driver)
N RETURN,TYPE
S TYPE=$$UP^XLFSTR($E($G(TEST),1))
I "^P^L^"'[(U_TYPE_U) S NFOUND=0 Q
;BRANCHING LOGIC EXECUTES BEFORE TIU OBJECT
I '$D(^TMP("WVGETORDERS",$J,TYPE)) S RETURN=$$GETORDRS^WVRPCPT1(DFN,TYPE,1)
S NFOUND=1,DATA(NFOUND,"COUNT")=+$G(^TMP("WVGETORDERS",$J,TYPE))
S TEST(NFOUND)=$S(DATA(NFOUND,"COUNT")>0:1,1:0),DATE(NFOUND)=$P($$NOW^PXRMDATE,".")
S TEXT(NFOUND)=$S(TEST(NFOUND):DATA(NFOUND,"COUNT"),1:"No")_" unsafe order"_$S(DATA(NFOUND,"COUNT")=1:" was",1:"s were")_" returned."
K ^TMP("WVGETORDERS",$J,TYPE)
I $D(RETURN) K @($P(RETURN,"@",2))
Q
PATIS(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
;determining if the patient is documented as pregnant or lactating on a
;date or within a date range
N RETURN,DATES,ISWAS,EXTRA,CALEND
S DATES("START")=$P($G(BDT),"."),DATES("END")=$P($G(EDT),".")
I +DATES("START")<1 D
.I +DATES("END")>1 S DATES("START")=+DATES("END"),DATES("END")=""
.E S DATES("START")=$$TODAY^PXRMDATE
S TEST=$S($G(TEST)'="":$$UP^XLFSTR(TEST),1:"PREGNANT"),NFOUND=1,RETURN=0
S CALEND=$S(TEST="PREGNANT^DIALOG":1,1:0)
I $P(TEST,U)="PREGNANT" D
.S RETURN=$$ISPREG^WVUTL11(DFN,DATES("START"),DATES("END"),CALEND)
.S DATA(NFOUND,"STATUS")=$S(RETURN=1:"PREGNANT",1:"NOT PREGNANT OR UNKNOWN")
I $P(TEST,U)="LACTATING" D
.S RETURN=$$ISLACT^WVUTL11(DFN,DATES("START"),DATES("END"),CALEND)
.S DATA(NFOUND,"STATUS")=$S(RETURN=1:"LACTATING",1:"NOT LACTATING OR UNKNOWN")
S TEST(NFOUND)=RETURN,DATE(NFOUND)=DATES("START")
I +DATES("END")>1 S TEXT(NFOUND)="For the date range "_$$FMTE^XLFDT(DATES("START"))_" to "_$$FMTE^XLFDT(DATES("END"))_", ",ISWAS="was",EXTRA=$S(RETURN=1:" on at least one of those days",1:"")
I +DATES("END")<1 S TEXT(NFOUND)="On "_$$FMTE^XLFDT(DATES("START"))_", ",ISWAS=$S(DATES("START")=DT:"is",1:"was")
S TEXT(NFOUND)=TEXT(NFOUND)_"the patient "_ISWAS_" "_DATA(NFOUND,"STATUS")_$G(EXTRA)_"."
Q
ROCTEXT(DFN) ;TIU object that returns reminder evaluation information for
;inclusion in the text for a reminder order check
N OUTPUT,RIEN,RNAME,NUM,CNT
S OUTPUT=$NA(^TMP("PXRM ROC TEXT",$J))
K @OUTPUT
I '$D(^TMP("PXRM BL DATA",$J,"PXRHM")) S @OUTPUT@(1,0)="This object can only be used in the text for a reminder order check." Q "~@"_OUTPUT
S RIEN=$G(^TMP("PXRM BL DATA",$J,"REMINDER IEN")),RNAME=$G(^TMP("PXRM BL DATA",$J,"REMINDER NAME")),CNT=0
S NUM=0 F S NUM=+$O(^TMP("PXRM BL DATA",$J,"PXRHM",RIEN,RNAME,"TXT",NUM)) Q:NUM'>0 D
.S CNT=CNT+1
.S @OUTPUT@(CNT,0)="\\"_$G(^TMP("PXRM BL DATA",$J,"PXRHM",RIEN,RNAME,"TXT",NUM))
K ^TMP("PXRM BL DATA",$J)
I 'CNT S @OUTPUT@(1,0)="The reminder evaluation text is not available."
Q "~@"_OUTPUT
GETPREGT(DFN) ;TIU object that returns a summary for the most recent lab
;pregnancy test
N OUTPUT,TERMIEN,TERMARR,FIEVAL,PXRMPID,TYPE,CNT,FIND,STATE,DATE,ERROR
S OUTPUT=$NA(^TMP("PXRM PREGNANCY TEST",$J))
K @OUTPUT
S TERMIEN=+$O(^PXRMD(811.5,"B","VA-WH PREGNANCY TEST ORDERED",0))
I 'TERMIEN D Q "~@"_OUTPUT
.S @OUTPUT@(1,0)="ERROR: Could not find the VA-WH PREGNANCY TEST ORDERED reminder term."
.S @OUTPUT@(2,0)=""
D GETDATA^WVRPCPT("PXRMWHDATA",DFN,"P",,,1)
S STATE=$P($G(^TMP("PXRMWHDATA",$J,1,"PREGNANCY STATE")),U,2)
S DATE=$P($P($G(^TMP("PXRMWHDATA",$J,1,"PREGNANCY STATUS D/T ENTERED")),U),".")
K ^TMP("PXRMWHDATA",$J)
I STATE'="DO NOT KNOW" S @OUTPUT@(1,0)="" Q "~@"_OUTPUT
S PXRMPID="PXRM"_TERMIEN_$H
D TERM^PXRMLDR(TERMIEN,.TERMARR)
S $P(TERMARR(20,1,0),U,8)=DATE,$P(TERMARR(20,1,0),U,11)=DT
D IEVALTER^PXRMTERM(DFN,.TERMARR,.TERMARR,1,.FIEVAL)
I $D(^TMP(PXRMPID,$J,TERMIEN)) D
.S CNT=1
.S TYPE="" F S TYPE=$O(^TMP(PXRMPID,$J,TERMIEN,TYPE)) Q:TYPE="" D
..S ERROR="" F S ERROR=$O(^TMP(PXRMPID,$J,TERMIEN,TYPE,ERROR)) Q:ERROR="" D
...S @OUTPUT@(CNT,0)=$G(^TMP(PXRMPID,$J,TERMIEN,TYPE,ERROR,TERMIEN))
...S CNT=CNT+1
.K ^TMP(PXRMPID,$J,TERMIEN)
I '$D(^TMP(PXRMPID,$J,TERMIEN)) D
.S CNT=4
.S FIND=0 F S FIND=$O(FIEVAL(FIND)) Q:'+FIND D
..I FIEVAL(FIND)=0 S CNT=1 Q
..S @OUTPUT@(CNT,0)=$$LJ^XLFSTR($P($G(FIEVAL(FIND,"ORDER")),U,2),42)
..S @OUTPUT@(CNT,0)=@OUTPUT@(CNT,0)_$$FMTE^XLFDT($P($G(FIEVAL(FIND,"START DATE")),"."))
..S @OUTPUT@(CNT,0)=@OUTPUT@(CNT,0)_" "_$$TITLE^XLFSTR($G(FIEVAL(FIND,"STATUS")))
..S CNT=CNT+1
.Q:CNT=1
.S @OUTPUT@(1,0)="The following laboratory test"_$S(CNT>5:"s were",1:" was")_" found:"
.S @OUTPUT@(2,0)="TEST NAME START DATE STATUS"
.S @OUTPUT@(3,0)=$$REPEAT^XLFSTR("=",65)
S @OUTPUT@(CNT,0)=""
Q "~@"_OUTPUT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCWH1 10324 printed Oct 16, 2024@17:44:19 Page 2
PXRMCWH1 ;ISP/RFR - COMPUTED FINDINGS FOR TERATOGENIC DRUGS;Dec 17, 2020@14:27
+1 ;;2.0;CLINICAL REMINDERS;**45,71**;Feb 4, 2005;Build 43
+2 QUIT
DEFGRACE() ;Return default grace period when none is specified
+1 QUIT "4W"
DOCSTAT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
+1 ;documentation on file
+2 NEW WHTYPE,WHSDIR,IDX,ELEMENTS,ELEMENT,WHGRACE,WHDOCDT,SOURCE
+3 SET WHSDIR=$SELECT($GET(NGET)<0:1,1:-1)
+4 SET NGET=$SELECT($GET(NGET)<0:-NGET,1:$GET(NGET))
+5 SET TEST=$SELECT($GET(TEST)'="":$$UP^XLFSTR(TEST),1:"PREGNANCIES")
+6 SET WHTYPE("PREGNANCIES")="P"_U_"Pregnancy"_U_"pregnancy"_U_"PREGNANCY STATE"_U_"PREGNANCY STATUS"
+7 SET WHTYPE("LACTATIONS")="L"_U_"Lactation"_U_"lactation"_U_"LACTATION STATE"_U_"LACTATION STATUS"
+8 IF $PIECE(TEST,U,2)="DATA"
SET DATA(1,"DIALOG")=1
SET DATA(1,"PACKAGE")="WOMEN'S HEALTH"
SET DATA(1,"PACKAGE PREFIX")="WV"
+9 SET WHGRACE=$$GETGRACE(TEST)
+10 SET TEST=$PIECE(TEST,U)
+11 SET WHTYPE=$PIECE(WHTYPE(TEST),U)
+12 SET ELEMENTS("DOCUMENTATION STATUS")=2
+13 SET ELEMENTS($PIECE(WHTYPE(TEST),U,4))=2
+14 IF TEST="PREGNANCIES"
Begin DoDot:1
+15 SET ELEMENTS("MEDICALLY UNABLE TO CONCEIVE")=2
+16 SET ELEMENTS("MEDICAL REASON")=1
+17 SET ELEMENTS("TRYING TO BECOME PREGNANT")=2
+18 SET ELEMENTS("CONTRACEPTIVE METHOD USED")=2
+19 SET ELEMENTS("LAST MENSTRUAL PERIOD DATE")=1
+20 SET ELEMENTS("EDD")=1
+21 SET ELEMENTS("PREGNANCY END DATE")=1
+22 SET ELEMENTS("PREGNANCY LIKELIHOOD")=2
+23 SET ELEMENTS("REASON PREGNANCY ENDED")=1
+24 SET ELEMENTS("OVERRIDE CALCULATED EDD REASON")=1
End DoDot:1
+25 IF TEST="LACTATIONS"
Begin DoDot:1
+26 SET ELEMENTS("END DATE")=1
End DoDot:1
+27 SET DATE(1)=$PIECE($$NOW^PXRMDATE,".")
SET TEST(1)=1
+28 SET TEXT(1)=$SELECT($GET(DATA(1,"DIALOG"))=1:" ",1:"")_"No documented "_$PIECE(WHTYPE(TEST),U,3)_" status."
+29 DO GETDATA^WVRPCPT("PXRMWHDATA",DFN,WHTYPE,$GET(BDT),$GET(EDT),NGET,WHSDIR,DATE(1))
+30 FOR IDX=1:1:$GET(^TMP("PXRMWHDATA",$JOB))
Begin DoDot:1
+31 SET TEST(IDX)=1
SET DATA(IDX,"DATE/TIME")=$PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,$PIECE(WHTYPE(TEST),U,5)_" D/T ENTERED")),U)
+32 SET DATE(IDX)=$PIECE(DATA(IDX,"DATE/TIME"),".")
+33 SET WHDOCDT=$PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,$PIECE(WHTYPE(TEST),U,5)_" D/T ENTERED")),U,2)
+34 SET DATA(IDX,$$UP^XLFSTR($PIECE(WHTYPE(TEST),U,2))_" DAS")=$GET(^TMP("PXRMWHDATA",$JOB,IDX,"RECORD ID"))
+35 SET DATA(IDX,$$UP^XLFSTR($PIECE(WHTYPE(TEST),U,2))_" DATA SOURCE")=$PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,"DATA SOURCE")),U,2)
+36 SET DATA(IDX,"VISIT")=$GET(^TMP("PXRMWHDATA",$JOB,IDX,"VISIT STRING"))
+37 SET ELEMENT=""
FOR
SET ELEMENT=$ORDER(ELEMENTS(ELEMENT))
if ELEMENT=""
QUIT
Begin DoDot:2
+38 IF $DATA(^TMP("PXRMWHDATA",$JOB,IDX,ELEMENT))>9
Begin DoDot:3
+39 SET ELEMENT(1)=0
FOR
SET ELEMENT(1)=$ORDER(^TMP("PXRMWHDATA",$JOB,IDX,ELEMENT,ELEMENT(1)))
if 'ELEMENT(1)
QUIT
Begin DoDot:4
+40 SET DATA(IDX,ELEMENT,ELEMENT(1))=$PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,ELEMENT,ELEMENT(1))),U,ELEMENTS(ELEMENT))
End DoDot:4
End DoDot:3
QUIT
+41 IF $DATA(^TMP("PXRMWHDATA",$JOB,IDX,ELEMENT))=1
Begin DoDot:3
+42 SET DATA(IDX,ELEMENT)=$PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,ELEMENT)),U,ELEMENTS(ELEMENT))
+43 IF ELEMENT="EDD"
Begin DoDot:4
+44 SET DATA(IDX,(ELEMENT_"-GRACE"))=$$NEWDATE^PXRMDATE($GET(DATA(IDX,ELEMENT)),"+",WHGRACE)
+45 SET DATA(IDX,"TWENTY-EIGHT WEEKS' GESTATION")=$$NEWDATE^PXRMDATE($GET(DATA(IDX,ELEMENT)),"-","12W")
End DoDot:4
End DoDot:3
End DoDot:2
+46 IF $PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,"MEDICALLY UNABLE TO CONCEIVE")),U)
Begin DoDot:2
+47 SET TEXT(IDX)="Medically unable to conceive "
+48 NEW SUBTEXT
SET SUBTEXT=$PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,"MEDICAL REASON")),U,ELEMENTS("MEDICAL REASON"))
+49 IF SUBTEXT'=""
SET TEXT(IDX)=TEXT(IDX)_"("_SUBTEXT_") "
+50 SET TEXT(IDX)=TEXT(IDX)_"documented on "_WHDOCDT
End DoDot:2
+51 IF '$TEST
SET TEXT(IDX)=$PIECE(WHTYPE(TEST),U,2)_" status "_$GET(DATA(IDX,$PIECE(WHTYPE(TEST),U,4)))_" documented on "_WHDOCDT
+52 IF $GET(DATA(IDX,"DOCUMENTATION STATUS"))="INCOMPLETE"
Begin DoDot:2
+53 IF $GET(DATA(IDX,$$UP^XLFSTR($PIECE(WHTYPE(TEST),U,2))_" DATA SOURCE"))="ORDER ENTRY/RESULTS REPORTING"
Begin DoDot:3
+54 SET SOURCE="on the Cover Sheet"
End DoDot:3
+55 IF '$TEST
SET SOURCE="via the "_$$TITLE^XLFSTR($GET(DATA(IDX,$$UP^XLFSTR($PIECE(WHTYPE(TEST),U,2))_" DATA SOURCE")))_" software package"
+56 SET TEXT(IDX)=TEXT(IDX)_" was entered "_SOURCE_" but the clinical reminder dialog was not completed"
End DoDot:2
+57 SET TEXT(IDX)=TEXT(IDX)_"."
+58 IF $PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,$PIECE(WHTYPE(TEST),U,4))),U)=1
IF TEST="PREGNANCIES"
Begin DoDot:2
+59 SET TEXT(IDX)=TEXT(IDX)_"\\LAST MENSTRUAL PERIOD: "_$PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,"LAST MENSTRUAL PERIOD DATE")),U,2)
+60 IF $PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,"PREGNANCY END DATE")),U)>0
Begin DoDot:3
+61 SET TEXT(IDX)=TEXT(IDX)_"\\PREGNANCY ENDED: "_$PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,"PREGNANCY END DATE")),U,2)
End DoDot:3
+62 IF '$TEST
SET TEXT(IDX)=TEXT(IDX)_"\\EDD: "_$PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,"EDD")),U,2)
End DoDot:2
+63 IF $PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,$PIECE(WHTYPE(TEST),U,4))),U)=0
IF TEST="LACTATIONS"
IF $PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,"END DATE")),U)>0
Begin DoDot:2
+64 SET TEXT(IDX)=TEXT(IDX)_"\\END DATE: "_$PIECE($GET(^TMP("PXRMWHDATA",$JOB,IDX,"END DATE")),U,2)
End DoDot:2
+65 IF $GET(DATA(1,"DIALOG"))=1
SET TEXT(IDX)=" "_TEXT(IDX)
End DoDot:1
+66 IF +$GET(^TMP("PXRMWHDATA",$JOB))<0
Begin DoDot:1
+67 SET TEXT(1)=$SELECT($GET(DATA(1,"DIALOG"))=1:" ",1:"")_"Unable to retrieve documentation due to a Women's Health package "
+68 SET TEXT(1)=TEXT(1)_"error; "_$PIECE(^TMP("PXRMWHDATA",$JOB),U,2)
+69 SET DATA(1,"DOCUMENTATION STATUS")="NO DOCUMENTATION"
End DoDot:1
+70 IF +$GET(^TMP("PXRMWHDATA",$JOB))=0
Begin DoDot:1
+71 SET DATA(1,"DOCUMENTATION STATUS")="NO DOCUMENTATION"
End DoDot:1
+72 SET NFOUND=$SELECT(+$GET(^TMP("PXRMWHDATA",$JOB))>0:+$GET(^TMP("PXRMWHDATA",$JOB)),1:1)
+73 KILL ^TMP("PXRMWHDATA",$JOB)
+74 QUIT
GETGRACE(TEST) ;Return the EDD grace period
+1 SET TEST=$GET(TEST)
+2 QUIT $SELECT($PIECE(TEST,U,3)'="":$PIECE(TEST,U,3),1:$$DEFGRACE)
GETGRACD() ;Return number of days in the EDD grace period
+1 NEW CFIEN,RDIEN,PERIOD,CDT
+2 SET CFIEN=+$ORDER(^PXRMD(811.4,"B","VA-WH PATIENT DOCUMENTATION",0))
if 'CFIEN
QUIT 0
+3 SET CFIEN=CFIEN_";PXRMD(811.4,"
+4 SET RDIEN=+$ORDER(^PXD(811.9,"B","VA-WH UPDATE PREGNANCY STATUS",0))
if 'RDIEN
QUIT 0
+5 SET CFIEN("SUB")=+$ORDER(^PXD(811.9,RDIEN,20,"B",CFIEN,0))
if 'CFIEN("SUB")
QUIT 0
+6 SET PERIOD=$$GETGRACE($GET(^PXD(811.9,RDIEN,20,CFIEN("SUB"),15)))
+7 SET CDT=$$NEWDATE^PXRMDATE(DT,"+",PERIOD)
+8 QUIT $$FMDIFF^XLFDT(CDT,DT)
ORDERCNT(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
+1 ;number of unsafe orders returned by GETORDRS^WVRPCPT1 (TIU object driver)
+2 NEW RETURN,TYPE
+3 SET TYPE=$$UP^XLFSTR($EXTRACT($GET(TEST),1))
+4 IF "^P^L^"'[(U_TYPE_U)
SET NFOUND=0
QUIT
+5 ;BRANCHING LOGIC EXECUTES BEFORE TIU OBJECT
+6 IF '$DATA(^TMP("WVGETORDERS",$JOB,TYPE))
SET RETURN=$$GETORDRS^WVRPCPT1(DFN,TYPE,1)
+7 SET NFOUND=1
SET DATA(NFOUND,"COUNT")=+$GET(^TMP("WVGETORDERS",$JOB,TYPE))
+8 SET TEST(NFOUND)=$SELECT(DATA(NFOUND,"COUNT")>0:1,1:0)
SET DATE(NFOUND)=$PIECE($$NOW^PXRMDATE,".")
+9 SET TEXT(NFOUND)=$SELECT(TEST(NFOUND):DATA(NFOUND,"COUNT"),1:"No")_" unsafe order"_$SELECT(DATA(NFOUND,"COUNT")=1:" was",1:"s were")_" returned."
+10 KILL ^TMP("WVGETORDERS",$JOB,TYPE)
+11 IF $DATA(RETURN)
KILL @($PIECE(RETURN,"@",2))
+12 QUIT
PATIS(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
+1 ;determining if the patient is documented as pregnant or lactating on a
+2 ;date or within a date range
+3 NEW RETURN,DATES,ISWAS,EXTRA,CALEND
+4 SET DATES("START")=$PIECE($GET(BDT),".")
SET DATES("END")=$PIECE($GET(EDT),".")
+5 IF +DATES("START")<1
Begin DoDot:1
+6 IF +DATES("END")>1
SET DATES("START")=+DATES("END")
SET DATES("END")=""
+7 IF '$TEST
SET DATES("START")=$$TODAY^PXRMDATE
End DoDot:1
+8 SET TEST=$SELECT($GET(TEST)'="":$$UP^XLFSTR(TEST),1:"PREGNANT")
SET NFOUND=1
SET RETURN=0
+9 SET CALEND=$SELECT(TEST="PREGNANT^DIALOG":1,1:0)
+10 IF $PIECE(TEST,U)="PREGNANT"
Begin DoDot:1
+11 SET RETURN=$$ISPREG^WVUTL11(DFN,DATES("START"),DATES("END"),CALEND)
+12 SET DATA(NFOUND,"STATUS")=$SELECT(RETURN=1:"PREGNANT",1:"NOT PREGNANT OR UNKNOWN")
End DoDot:1
+13 IF $PIECE(TEST,U)="LACTATING"
Begin DoDot:1
+14 SET RETURN=$$ISLACT^WVUTL11(DFN,DATES("START"),DATES("END"),CALEND)
+15 SET DATA(NFOUND,"STATUS")=$SELECT(RETURN=1:"LACTATING",1:"NOT LACTATING OR UNKNOWN")
End DoDot:1
+16 SET TEST(NFOUND)=RETURN
SET DATE(NFOUND)=DATES("START")
+17 IF +DATES("END")>1
SET TEXT(NFOUND)="For the date range "_$$FMTE^XLFDT(DATES("START"))_" to "_$$FMTE^XLFDT(DATES("END"))_", "
SET ISWAS="was"
SET EXTRA=$SELECT(RETURN=1:" on at least one of those days",1:"")
+18 IF +DATES("END")<1
SET TEXT(NFOUND)="On "_$$FMTE^XLFDT(DATES("START"))_", "
SET ISWAS=$SELECT(DATES("START")=DT:"is",1:"was")
+19 SET TEXT(NFOUND)=TEXT(NFOUND)_"the patient "_ISWAS_" "_DATA(NFOUND,"STATUS")_$GET(EXTRA)_"."
+20 QUIT
ROCTEXT(DFN) ;TIU object that returns reminder evaluation information for
+1 ;inclusion in the text for a reminder order check
+2 NEW OUTPUT,RIEN,RNAME,NUM,CNT
+3 SET OUTPUT=$NAME(^TMP("PXRM ROC TEXT",$JOB))
+4 KILL @OUTPUT
+5 IF '$DATA(^TMP("PXRM BL DATA",$JOB,"PXRHM"))
SET @OUTPUT@(1,0)="This object can only be used in the text for a reminder order check."
QUIT "~@"_OUTPUT
+6 SET RIEN=$GET(^TMP("PXRM BL DATA",$JOB,"REMINDER IEN"))
SET RNAME=$GET(^TMP("PXRM BL DATA",$JOB,"REMINDER NAME"))
SET CNT=0
+7 SET NUM=0
FOR
SET NUM=+$ORDER(^TMP("PXRM BL DATA",$JOB,"PXRHM",RIEN,RNAME,"TXT",NUM))
if NUM'>0
QUIT
Begin DoDot:1
+8 SET CNT=CNT+1
+9 SET @OUTPUT@(CNT,0)="\\"_$GET(^TMP("PXRM BL DATA",$JOB,"PXRHM",RIEN,RNAME,"TXT",NUM))
End DoDot:1
+10 KILL ^TMP("PXRM BL DATA",$JOB)
+11 IF 'CNT
SET @OUTPUT@(1,0)="The reminder evaluation text is not available."
+12 QUIT "~@"_OUTPUT
GETPREGT(DFN) ;TIU object that returns a summary for the most recent lab
+1 ;pregnancy test
+2 NEW OUTPUT,TERMIEN,TERMARR,FIEVAL,PXRMPID,TYPE,CNT,FIND,STATE,DATE,ERROR
+3 SET OUTPUT=$NAME(^TMP("PXRM PREGNANCY TEST",$JOB))
+4 KILL @OUTPUT
+5 SET TERMIEN=+$ORDER(^PXRMD(811.5,"B","VA-WH PREGNANCY TEST ORDERED",0))
+6 IF 'TERMIEN
Begin DoDot:1
+7 SET @OUTPUT@(1,0)="ERROR: Could not find the VA-WH PREGNANCY TEST ORDERED reminder term."
+8 SET @OUTPUT@(2,0)=""
End DoDot:1
QUIT "~@"_OUTPUT
+9 DO GETDATA^WVRPCPT("PXRMWHDATA",DFN,"P",,,1)
+10 SET STATE=$PIECE($GET(^TMP("PXRMWHDATA",$JOB,1,"PREGNANCY STATE")),U,2)
+11 SET DATE=$PIECE($PIECE($GET(^TMP("PXRMWHDATA",$JOB,1,"PREGNANCY STATUS D/T ENTERED")),U),".")
+12 KILL ^TMP("PXRMWHDATA",$JOB)
+13 IF STATE'="DO NOT KNOW"
SET @OUTPUT@(1,0)=""
QUIT "~@"_OUTPUT
+14 SET PXRMPID="PXRM"_TERMIEN_$HOROLOG
+15 DO TERM^PXRMLDR(TERMIEN,.TERMARR)
+16 SET $PIECE(TERMARR(20,1,0),U,8)=DATE
SET $PIECE(TERMARR(20,1,0),U,11)=DT
+17 DO IEVALTER^PXRMTERM(DFN,.TERMARR,.TERMARR,1,.FIEVAL)
+18 IF $DATA(^TMP(PXRMPID,$JOB,TERMIEN))
Begin DoDot:1
+19 SET CNT=1
+20 SET TYPE=""
FOR
SET TYPE=$ORDER(^TMP(PXRMPID,$JOB,TERMIEN,TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+21 SET ERROR=""
FOR
SET ERROR=$ORDER(^TMP(PXRMPID,$JOB,TERMIEN,TYPE,ERROR))
if ERROR=""
QUIT
Begin DoDot:3
+22 SET @OUTPUT@(CNT,0)=$GET(^TMP(PXRMPID,$JOB,TERMIEN,TYPE,ERROR,TERMIEN))
+23 SET CNT=CNT+1
End DoDot:3
End DoDot:2
+24 KILL ^TMP(PXRMPID,$JOB,TERMIEN)
End DoDot:1
+25 IF '$DATA(^TMP(PXRMPID,$JOB,TERMIEN))
Begin DoDot:1
+26 SET CNT=4
+27 SET FIND=0
FOR
SET FIND=$ORDER(FIEVAL(FIND))
if '+FIND
QUIT
Begin DoDot:2
+28 IF FIEVAL(FIND)=0
SET CNT=1
QUIT
+29 SET @OUTPUT@(CNT,0)=$$LJ^XLFSTR($PIECE($GET(FIEVAL(FIND,"ORDER")),U,2),42)
+30 SET @OUTPUT@(CNT,0)=@OUTPUT@(CNT,0)_$$FMTE^XLFDT($PIECE($GET(FIEVAL(FIND,"START DATE")),"."))
+31 SET @OUTPUT@(CNT,0)=@OUTPUT@(CNT,0)_" "_$$TITLE^XLFSTR($GET(FIEVAL(FIND,"STATUS")))
+32 SET CNT=CNT+1
End DoDot:2
+33 if CNT=1
QUIT
+34 SET @OUTPUT@(1,0)="The following laboratory test"_$SELECT(CNT>5:"s were",1:" was")_" found:"
+35 SET @OUTPUT@(2,0)="TEST NAME START DATE STATUS"
+36 SET @OUTPUT@(3,0)=$$REPEAT^XLFSTR("=",65)
End DoDot:1
+37 SET @OUTPUT@(CNT,0)=""
+38 QUIT "~@"_OUTPUT
