BTIULO13.m

BTIULO13 ;IHS/MSC/MGH - IHS OBJECTS ADDED IN PATCHES ;23-May-2016 15:35;DU

 ;;1.0;TEXT INTEGRATION UTILITIES;**1006,1009,1010,1011,1012,1017**;NOV 04, 2004;Build 7

TMORDER(DFN,TARGET) ;EP Med Orders for today

 NEW X,I,CNT,RESULT

 S CNT=0

 D GETORD(.RESULT,DFN)

 K @TARGET

 S I=0 F  S I=$O(RESULT(I)) Q:'I  D

 .I $G(RESULT(I))'="" D

 ..S CNT=CNT+1

 ..S @TARGET@(CNT,0)=RESULT(I)

 I 'CNT S @TARGET@(1,0)="No Orders."

 Q "~@"_$NA(@TARGET)

GETORD(RETURN,DFN) ;Get list of orders

 K RETURN

 NEW VDT,END,ORLIST,NEWORD,ORD,HDR,HLF,LOC,X,Y,C,GROUP,GROUPIEN,ORDER,OLDOR

 S C=0,OLDOR=0

 K ^TMP("ORR",$J)

 ;Get all orders for today

 S VDT=DT,END=VDT_".2359"

 I '$L($T(EN^ORQ1)) Q

 S GROUP="OUTPATIENT MEDICATIONS",GROUPIEN=""

 S GROUPIEN=$O(^ORD(100.98,"B",GROUP,""))

 D EN^ORQ1(DFN_";DPT(",GROUPIEN,2,"",VDT,END,1)

 I '$D(ORLIST) S RETURN(1)="" Q

 F X=0:0 S X=$O(^TMP("ORR",$J,ORLIST,X)) Q:'X  K ORD M ORD=^(X) D

 . S Y=$P($G(^OR(100,+ORD,0)),U,10)

 . I $P(ORD,U,7)="canc" Q

 . S ORDER=+ORD

 . Q:ORDER=OLDOR

 . S ORDER=OLDOR

 . S C=C+1

 . F Y=0:0 S Y=$O(ORD("TX",Y)) Q:'Y  D

 .. I $E(ORD("TX",Y),1)="<" Q

 .. ;I $E(ORD("TX",Y),1,6)="Change" Q

 .. I $E(ORD("TX",Y),1,6)="Change" S ORD("TX",Y)=$E(ORD("TX",Y),8,999)

 .. ;I $E(ORD("TX",Y),1,3)="to " Q

 .. I $E(ORD("TX",Y),1,3)="to " D

 ... K RETURN(C)

 ... S NEWORD=$E(ORD("TX",Y),4,999)

 ... S RETURN(C)="  "_NEWORD

 .. E  S RETURN(C)=$G(RETURN(C))_"  "_$P(ORD("TX",Y)," Quantity:")

 I C=0 S RETURN(1)=""

 K ^TMP("ORR",$J)

 Q

PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data

 Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)

 ;

SP(NUM) ; -- SUBRTN to pad spaces

 Q $$PAD(" ",NUM)

TOBACCO(DFN,TARGET) ;EP for new tobacco object

 NEW CTGN,HF,HFDT,LIST,RESULT,X,BTIU,CNT,CTG,X1

 I '$G(DFN) Q ""

 S CNT=0

 F BTIU=1:1 D  Q:CTG=""

 .S CTG=$P($T(TOBU+BTIU),";;",2)

 .Q:CTG=""

 .S CTGN=$O(^AUTTHF("B",CTG,0)) I 'CTGN Q    ;ien of category passed

 .;

 .S HF=0

 .F  S HF=$O(^AUTTHF("AC",CTGN,HF))  Q:'+HF  D        ;find health factors in category

 ..Q:'$D(^AUPNVHF("AA",DFN,HF))                     ;quit if patient doesn't have health factor

 ..S HFDT=$O(^AUPNVHF("AA",DFN,HF,"")) Q:'HFDT      ;get visit date for health factor

 ..S LIST(CTG,HFDT)=$O(^AUPNVHF("AA",DFN,HF,HFDT,""))   ;store iens by date

 ;

 S X1=0 F  S X1=$O(LIST(X1)) Q:X1=""  D

 .S HFDT=$O(LIST(X1,0))

 .Q:HFDT=""                    ;find latest date (inverse dates)

 .S RESULT=$S($G(CAP)=1:"Last "_CTG_" HF: ",1:"")

 .S RESULT=RESULT_$$GET1^DIQ(9000010.23,LIST(X1,HFDT),.01)

 .S X=$$GET1^DIQ(9000010.23,LIST(X1,HFDT),.04)    ;severity level

 .S RESULT=RESULT_$S(X]"":" ( "_X_")",1:"")

 .S RESULT=RESULT_" - "_$$FMTE^XLFDT(9999999-HFDT)

 .S CNT=CNT+1 S @TARGET@(CNT,0)=RESULT

 I 'CNT S @TARGET@(1,0)="No Tobacco health factors."

 Q "~@"_$NA(@TARGET)

TOBU ;;

 ;;TOBACCO (EXPOSURE)

 ;;TOBACCO (SMOKELESS - CHEWING/DIP)

 ;;TOBACCO (SMOKING)

 ;

ACTIVITY(DFN,VISIT) ;EP; returns # of activity minutes for visit in V Activity file

 I '$G(VISIT) D  I $G(VISIT)<1 Q "Invalid visit"

 . I $T(GETVAR^CIAVMEVT)="" Q

 . NEW VST

 . S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")

 . I VST="" Q

 . S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 Q

 . ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 Q

 . S VISIT=VST

 ;

 NEW IEN,X S IEN=$O(^AUPNVTM("AD",VISIT,0)) I 'IEN Q " "

 S X=$$GET1^DIQ(9000010.19,IEN,.01)

 Q $S(X]"":X_" minutes",1:"")

 ;

TRAVEL(DFN,VISIT) ;EP; returns # of travel minutes for visit in V Activity file

 I '$G(VISIT) D  I $G(VISIT)<1 Q "Invalid visit"

 . I $T(GETVAR^CIAVMEVT)="" Q

 . NEW VST

 . S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")

 . I VST="" Q

 . S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 Q

 . ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 Q

 . S VISIT=VST

 ;

 NEW IEN,X S IEN=$O(^AUPNVTM("AD",VISIT,0)) I 'IEN Q ""

 S X=$$GET1^DIQ(9000010.19,IEN,.04)

 Q $S(X]"":X_" minutes",1:"")

 ;

TOTTIME(DFN,VISIT) ;EP; returns total # of minutes (activity & travel)

 NEW A,T

 I '$G(VISIT) D  I $G(VISIT)<1 Q "Invalid visit"

 . I $T(GETVAR^CIAVMEVT)="" Q

 . NEW VST

 . S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")

 . I VST="" Q

 . S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 Q

 . S VISIT=VST

 ;

 S A=$$ACTIVITY($G(DFN),$G(VISIT)),T=$$TRAVEL($G(DFN),$G(VISIT))

 Q (A+T)_" minutes"

 ;

 ;IHS/MSC/MGH Added patch 1010

EDD(DFN) ;EP returns EDD

 N REP,EDD,PREG

 S PREG=$P($G(^AUPNREP(DFN,11)),U,1)

 Q:PREG'="Y" "Patient is not currently pregnant"

 S REP=$G(^AUPNREP(DFN,13))

 S EDD=$P(REP,U,11)

 S EDD=$$FMTDATE^BGOUTL(EDD)

 Q "Estimated Due Date: "_EDD

EDDALL(DFN,TARGET) ;Get pregnancy data

 N REP,LMP,LMPPR,LMPDT,ULTRA,ULTPR,ULTDT,CLIN,CLINPR,CLINDT,UN,UNPR,UNDT,EDD,EDDPR,EDDDT

 N PREG,PREGDT,PREGPR,LMPCO,ULTCO,DEFCO,UNCO,CLINCO,EDDCO

 S CNT=0

 S REP=$G(^AUPNREP(DFN,13))

 S PREG=$P($G(^AUPNREP(DFN,11)),U,1)

 ;EDD by LMP

 S LMP=$P(REP,U,2)

 I LMP'="" S LMP=$$FMTDATE^BGOUTL(LMP)

 ;EDD by ultrasound

 S ULTRA=$P(REP,U,5)

 I ULTRA'="" S ULTRA=$$FMTDATE^BGOUTL(ULTRA)

 ;EDD by clinical parameters

 S CLIN=$P(REP,U,8)

 I CLIN'="" S CLIN=$$FMTDATE^BGOUTL(CLIN)

 S EDD=$P(REP,U,11)

 I EDD'="" S EDD=$$FMTDATE^BGOUTL(EDD)

 ;EDD by unknown methods

 S UN=$P(REP,U,14)

 I UN'="" S UN=$$FMTDATE^BGOUTL(UN)

 I PREG="Y" D

 .I LMP'="" D

 ..S CNT=CNT+1

 ..S @TARGET@(CNT,0)="Due date by LMP: "_LMP

 .I ULTRA'="" D

 ..S CNT=CNT+1

 ..S @TARGET@(CNT,0)="Due date by Ultrasound: "_ULTRA

 .I CLIN'="" D

 ..S CNT=CNT+1

 ..S @TARGET@(CNT,0)="Due date by Clinical Measures: "_CLIN

 .I UN'="" D

 ..S CNT=CNT+1

 ..S @TARGET@(CNT,0)="Due date by Unknown Methods: "_UN

 .I EDD'="" D

 ..S CNT=CNT+1

 ..S @TARGET@(CNT,0)="Definitive EDD: "_EDD

 E  S CNT=CNT+1 S @TARGET@(CNT,0)="Patient is not currently pregnant"

 Q "~@"_$NA(@TARGET)

LACSTAT(DFN) ;Get lactation status

 N DATA,LAC,LAC1,LACDATE,TAGE

 I $P(^DPT(DFN,0),U,2)="M" S DATA="Patient is male" Q DATA

 S TAGE=$$GET1^DIQ(2,DFN,.033)

 I TAGE<10!(TAGE>55) S DATA="Patient is too young or old" Q DATA

 S LAC=$G(^AUPNREP(DFN,2))

 I LAC'="" D

 .S LAC1=$$GET1^DIQ(9000017,DFN,2.01)

 .I LAC1="" S LAC1="UNKNOWN"

 .S LACDATE=$$GET1^DIQ(9000017,DFN,2.02)

 .S DATA="Lactation Status: "_LAC1_" ("_LACDATE_")"

 E  S DATA="No documented lactation status"

 Q DATA

BTIULO13  ;IHS/MSC/MGH - IHS OBJECTS ADDED IN PATCHES ;23-May-2016 15:35;DU

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**1006,1009,1010,1011,1012,1017**;NOV 04, 2004;Build 7

TMORDER(DFN,TARGET) ;EP Med Orders for today

 +1        NEW X,I,CNT,RESULT

 +2        SET CNT=0

 +3        DO GETORD(.RESULT,DFN)

 +4        KILL @TARGET

 +5        SET I=0

           FOR 

               SET I=$ORDER(RESULT(I))

               IF 'I

                   QUIT 

               Begin DoDot:1

 +6                IF $GET(RESULT(I))'=""

                       Begin DoDot:2

 +7                        SET CNT=CNT+1

 +8                        SET @TARGET@(CNT,0)=RESULT(I)

                       End DoDot:2

               End DoDot:1

 +9        IF 'CNT

               SET @TARGET@(1,0)="No Orders."

 +10       QUIT "~@"_$NAME(@TARGET)

GETORD(RETURN,DFN) ;Get list of orders

 +1        KILL RETURN

 +2        NEW VDT,END,ORLIST,NEWORD,ORD,HDR,HLF,LOC,X,Y,C,GROUP,GROUPIEN,ORDER,OLDOR

 +3        SET C=0

           SET OLDOR=0

 +4        KILL ^TMP("ORR",$JOB)

 +5       ;Get all orders for today

 +6        SET VDT=DT

           SET END=VDT_".2359"

 +7        IF '$LENGTH($TEXT(EN^ORQ1))

               QUIT 

 +8        SET GROUP="OUTPATIENT MEDICATIONS"

           SET GROUPIEN=""

 +9        SET GROUPIEN=$ORDER(^ORD(100.98,"B",GROUP,""))

 +10       DO EN^ORQ1(DFN_";DPT(",GROUPIEN,2,"",VDT,END,1)

 +11       IF '$DATA(ORLIST)

               SET RETURN(1)=""

               QUIT 

 +12       FOR X=0:0

               SET X=$ORDER(^TMP("ORR",$JOB,ORLIST,X))

               IF 'X

                   QUIT 

               KILL ORD

               MERGE ORD=^(X)

               Begin DoDot:1

 +13               SET Y=$PIECE($GET(^OR(100,+ORD,0)),U,10)

 +14               IF $PIECE(ORD,U,7)="canc"

                       QUIT 

 +15               SET ORDER=+ORD

 +16               IF ORDER=OLDOR

                       QUIT 

 +17               SET ORDER=OLDOR

 +18               SET C=C+1

 +19               FOR Y=0:0

                       SET Y=$ORDER(ORD("TX",Y))

                       IF 'Y

                           QUIT 

                       Begin DoDot:2

 +20                       IF $EXTRACT(ORD("TX",Y),1)="<"

                               QUIT 

 +21      ;I $E(ORD("TX",Y),1,6)="Change" Q

 +22                       IF $EXTRACT(ORD("TX",Y),1,6)="Change"

                               SET ORD("TX",Y)=$EXTRACT(ORD("TX",Y),8,999)

 +23      ;I $E(ORD("TX",Y),1,3)="to " Q

 +24                       IF $EXTRACT(ORD("TX",Y),1,3)="to "

                               Begin DoDot:3

 +25                               KILL RETURN(C)

 +26                               SET NEWORD=$EXTRACT(ORD("TX",Y),4,999)

 +27                               SET RETURN(C)="  "_NEWORD

                               End DoDot:3

 +28                      IF '$TEST

                               SET RETURN(C)=$GET(RETURN(C))_"  "_$PIECE(ORD("TX",Y)," Quantity:")

                       End DoDot:2

               End DoDot:1

 +29       IF C=0

               SET RETURN(1)=""

 +30       KILL ^TMP("ORR",$JOB)

 +31       QUIT 

PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data

 +1        QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)

 +2       ;

SP(NUM)   ; -- SUBRTN to pad spaces

 +1        QUIT $$PAD(" ",NUM)

TOBACCO(DFN,TARGET) ;EP for new tobacco object

 +1        NEW CTGN,HF,HFDT,LIST,RESULT,X,BTIU,CNT,CTG,X1

 +2        IF '$GET(DFN)

               QUIT ""

 +3        SET CNT=0

 +4        FOR BTIU=1:1

               Begin DoDot:1

 +5                SET CTG=$PIECE($TEXT(TOBU+BTIU),";;",2)

 +6                IF CTG=""

                       QUIT 

 +7       ;ien of category passed

                   SET CTGN=$ORDER(^AUTTHF("B",CTG,0))

                   IF 'CTGN

                       QUIT 

 +8       ;

 +9                SET HF=0

 +10      ;find health factors in category

                   FOR 

                       SET HF=$ORDER(^AUTTHF("AC",CTGN,HF))

                       IF '+HF

                           QUIT 

                       Begin DoDot:2

 +11      ;quit if patient doesn't have health factor

                           IF '$DATA(^AUPNVHF("AA",DFN,HF))

                               QUIT 

 +12      ;get visit date for health factor

                           SET HFDT=$ORDER(^AUPNVHF("AA",DFN,HF,""))

                           IF 'HFDT

                               QUIT 

 +13      ;store iens by date

                           SET LIST(CTG,HFDT)=$ORDER(^AUPNVHF("AA",DFN,HF,HFDT,""))

                       End DoDot:2

               End DoDot:1

               IF CTG=""

                   QUIT 

 +14      ;

 +15       SET X1=0

           FOR 

               SET X1=$ORDER(LIST(X1))

               IF X1=""

                   QUIT 

               Begin DoDot:1

 +16               SET HFDT=$ORDER(LIST(X1,0))

 +17      ;find latest date (inverse dates)

                   IF HFDT=""

                       QUIT 

 +18               SET RESULT=$SELECT($GET(CAP)=1:"Last "_CTG_" HF: ",1:"")

 +19               SET RESULT=RESULT_$$GET1^DIQ(9000010.23,LIST(X1,HFDT),.01)

 +20      ;severity level

                   SET X=$$GET1^DIQ(9000010.23,LIST(X1,HFDT),.04)

 +21               SET RESULT=RESULT_$SELECT(X]"":" ( "_X_")",1:"")

 +22               SET RESULT=RESULT_" - "_$$FMTE^XLFDT(9999999-HFDT)

 +23               SET CNT=CNT+1

                   SET @TARGET@(CNT,0)=RESULT

               End DoDot:1

 +24       IF 'CNT

               SET @TARGET@(1,0)="No Tobacco health factors."

 +25       QUIT "~@"_$NAME(@TARGET)

TOBU      ;;

 +1       ;;TOBACCO (EXPOSURE)

 +2       ;;TOBACCO (SMOKELESS - CHEWING/DIP)

 +3       ;;TOBACCO (SMOKING)

 +4       ;

ACTIVITY(DFN,VISIT) ;EP; returns # of activity minutes for visit in V Activity file

 +1        IF '$GET(VISIT)

               Begin DoDot:1

 +2                IF $TEXT(GETVAR^CIAVMEVT)=""

                       QUIT 

 +3                NEW VST

 +4                SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")

 +5                IF VST=""

                       QUIT 

 +6                SET X="BEHOENCX"

                   XECUTE ^%ZOSF("TEST")

                   IF $TEST

                       SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)

                       IF VST<1

                           QUIT 

 +7       ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 Q

 +8                SET VISIT=VST

               End DoDot:1

               IF $GET(VISIT)<1

                   QUIT "Invalid visit"

 +9       ;

 +10       NEW IEN,X

           SET IEN=$ORDER(^AUPNVTM("AD",VISIT,0))

           IF 'IEN

               QUIT " "

 +11       SET X=$$GET1^DIQ(9000010.19,IEN,.01)

 +12       QUIT $SELECT(X]"":X_" minutes",1:"")

 +13      ;

TRAVEL(DFN,VISIT) ;EP; returns # of travel minutes for visit in V Activity file

 +1        IF '$GET(VISIT)

               Begin DoDot:1

 +2                IF $TEXT(GETVAR^CIAVMEVT)=""

                       QUIT 

 +3                NEW VST

 +4                SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")

 +5                IF VST=""

                       QUIT 

 +6                SET X="BEHOENCX"

                   XECUTE ^%ZOSF("TEST")

                   IF $TEST

                       SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)

                       IF VST<1

                           QUIT 

 +7       ;S X="CIAVCXEN" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^CIAVCXEN(DFN,VST) I VST<1 Q

 +8                SET VISIT=VST

               End DoDot:1

               IF $GET(VISIT)<1

                   QUIT "Invalid visit"

 +9       ;

 +10       NEW IEN,X

           SET IEN=$ORDER(^AUPNVTM("AD",VISIT,0))

           IF 'IEN

               QUIT ""

 +11       SET X=$$GET1^DIQ(9000010.19,IEN,.04)

 +12       QUIT $SELECT(X]"":X_" minutes",1:"")

 +13      ;

TOTTIME(DFN,VISIT) ;EP; returns total # of minutes (activity & travel)

 +1        NEW A,T

 +2        IF '$GET(VISIT)

               Begin DoDot:1

 +3                IF $TEXT(GETVAR^CIAVMEVT)=""

                       QUIT 

 +4                NEW VST

 +5                SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")

 +6                IF VST=""

                       QUIT 

 +7                SET X="BEHOENCX"

                   XECUTE ^%ZOSF("TEST")

                   IF $TEST

                       SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)

                       IF VST<1

                           QUIT 

 +8                SET VISIT=VST

               End DoDot:1

               IF $GET(VISIT)<1

                   QUIT "Invalid visit"

 +9       ;

 +10       SET A=$$ACTIVITY($GET(DFN),$GET(VISIT))

           SET T=$$TRAVEL($GET(DFN),$GET(VISIT))

 +11       QUIT (A+T)_" minutes"

 +12      ;

 +13      ;IHS/MSC/MGH Added patch 1010

EDD(DFN)  ;EP returns EDD

 +1        NEW REP,EDD,PREG

 +2        SET PREG=$PIECE($GET(^AUPNREP(DFN,11)),U,1)

 +3        IF PREG'="Y"

               QUIT "Patient is not currently pregnant"

 +4        SET REP=$GET(^AUPNREP(DFN,13))

 +5        SET EDD=$PIECE(REP,U,11)

 +6        SET EDD=$$FMTDATE^BGOUTL(EDD)

 +7        QUIT "Estimated Due Date: "_EDD

EDDALL(DFN,TARGET) ;Get pregnancy data

 +1        NEW REP,LMP,LMPPR,LMPDT,ULTRA,ULTPR,ULTDT,CLIN,CLINPR,CLINDT,UN,UNPR,UNDT,EDD,EDDPR,EDDDT

 +2        NEW PREG,PREGDT,PREGPR,LMPCO,ULTCO,DEFCO,UNCO,CLINCO,EDDCO

 +3        SET CNT=0

 +4        SET REP=$GET(^AUPNREP(DFN,13))

 +5        SET PREG=$PIECE($GET(^AUPNREP(DFN,11)),U,1)

 +6       ;EDD by LMP

 +7        SET LMP=$PIECE(REP,U,2)

 +8        IF LMP'=""

               SET LMP=$$FMTDATE^BGOUTL(LMP)

 +9       ;EDD by ultrasound

 +10       SET ULTRA=$PIECE(REP,U,5)

 +11       IF ULTRA'=""

               SET ULTRA=$$FMTDATE^BGOUTL(ULTRA)

 +12      ;EDD by clinical parameters

 +13       SET CLIN=$PIECE(REP,U,8)

 +14       IF CLIN'=""

               SET CLIN=$$FMTDATE^BGOUTL(CLIN)

 +15       SET EDD=$PIECE(REP,U,11)

 +16       IF EDD'=""

               SET EDD=$$FMTDATE^BGOUTL(EDD)

 +17      ;EDD by unknown methods

 +18       SET UN=$PIECE(REP,U,14)

 +19       IF UN'=""

               SET UN=$$FMTDATE^BGOUTL(UN)

 +20       IF PREG="Y"

               Begin DoDot:1

 +21               IF LMP'=""

                       Begin DoDot:2

 +22                       SET CNT=CNT+1

 +23                       SET @TARGET@(CNT,0)="Due date by LMP: "_LMP

                       End DoDot:2

 +24               IF ULTRA'=""

                       Begin DoDot:2

 +25                       SET CNT=CNT+1

 +26                       SET @TARGET@(CNT,0)="Due date by Ultrasound: "_ULTRA

                       End DoDot:2

 +27               IF CLIN'=""

                       Begin DoDot:2

 +28                       SET CNT=CNT+1

 +29                       SET @TARGET@(CNT,0)="Due date by Clinical Measures: "_CLIN

                       End DoDot:2

 +30               IF UN'=""

                       Begin DoDot:2

 +31                       SET CNT=CNT+1

 +32                       SET @TARGET@(CNT,0)="Due date by Unknown Methods: "_UN

                       End DoDot:2

 +33               IF EDD'=""

                       Begin DoDot:2

 +34                       SET CNT=CNT+1

 +35                       SET @TARGET@(CNT,0)="Definitive EDD: "_EDD

                       End DoDot:2

               End DoDot:1

 +36      IF '$TEST

               SET CNT=CNT+1

               SET @TARGET@(CNT,0)="Patient is not currently pregnant"

 +37       QUIT "~@"_$NAME(@TARGET)

LACSTAT(DFN) ;Get lactation status

 +1        NEW DATA,LAC,LAC1,LACDATE,TAGE

 +2        IF $PIECE(^DPT(DFN,0),U,2)="M"

               SET DATA="Patient is male"

               QUIT DATA

 +3        SET TAGE=$$GET1^DIQ(2,DFN,.033)

 +4        IF TAGE<10!(TAGE>55)

               SET DATA="Patient is too young or old"

               QUIT DATA

 +5        SET LAC=$GET(^AUPNREP(DFN,2))

 +6        IF LAC'=""

               Begin DoDot:1

 +7                SET LAC1=$$GET1^DIQ(9000017,DFN,2.01)

 +8                IF LAC1=""

                       SET LAC1="UNKNOWN"

 +9                SET LACDATE=$$GET1^DIQ(9000017,DFN,2.02)

 +10               SET DATA="Lactation Status: "_LAC1_" ("_LACDATE_")"

               End DoDot:1

 +11      IF '$TEST

               SET DATA="No documented lactation status"

 +12       QUIT DATA