Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMCWH1

PXRMCWH1.m

Go to the documentation of this file.
PXRMCWH1 ;ISP/RFR - COMPUTED FINDINGS FOR TERATOGENIC DRUGS;Jan 23, 2020@14:37
 ;;2.0;CLINICAL REMINDERS;**45**;Feb 4, 2005;Build 566
 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" S DATA(IDX,(ELEMENT_"-GRACE"))=$$NEWDATE^PXRMDATE($G(DATA(IDX,ELEMENT)),"+",WHGRACE)
 .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