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
