- 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 Feb 18, 2025@23:09:51 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
