Routine: APCLAPI7

APCLAPI7 ; IHS/CMI/LAB - visit data ; 15 Nov 2010  10:01 AM

 ;;2.0;IHS PCC SUITE;**5,7**;MAY 14, 2009

 ;IHS/TUCSON/LAB - added G parameter to provider call

VR ;EP

 S APCLLAST=$P(Y,U,1)_"^"_$P($$CPT^ICPTCOD(Y),U,2)_" "_$$VAL^XBDIQ1(9000010.22,.01,X)_"^^"_$P(^AUPNVRAD(X,0),U,3)_"^9000010.22^"_X

E ;

 I $P(APCLVAL,U,1)>$P(APCLLAST,U,1) S APCLLAST=APCLVAL

LASTSMOK(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TOBACCO (SMOKING)

 ;  Return the last recorded TOBACCO SMOKING SCREENING:

 ;   - V Health Factor in Category TOBACCO (SMOKING)

 ;   - V CPT [BGP SMOKING CPTS]

 ;   - V POV [BGP GPRA SMOKING DXS]

 ;   - V DENTAL ADA 1320

 ;  Input:

 ;   APCLPDFN - Patient DFN

 ;   APCLBD - beginning date to begin search for value - if blank, default is DOB

 ;   APCLED - ending date of search - if blank, default is DT

 ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801

 ;                                 A - return value:

 ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in

 I $G(APCLPDFN)="" Q ""

 I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 I $G(APCLED)="" S APCLED=DT

 I $G(APCLFORM)="" S APCLFORM="D"

 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E

 S APCLLAST=""

 S APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (SMOKING)",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")

D E

 S R=$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD)

 S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,R,APCLED,"APCL TOBACCO (SMOKING) CPTS","A")

D E

 S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"1320","ADA",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")

D E

 S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"[BGP GPRA SMOKING DXS","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")

D E

 I APCLFORM="D" Q $P(APCLLAST,U)

 Q APCLLAST

LASTSMLE(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TOBACCO (SMOKING)

 ;  Return the last recorded TOBACCO SMOKING SCREENING:

 ;   - V Health Factor in Category TOBACCO (SMOKLESS - CHEWING/DIP)

 ;   - V CPT [BGP SMOKELESS TOBACCO CPTS]

 ;   - V DENTAL ADA 1320

 ;  Input:

 ;   APCLPDFN - Patient DFN

 ;   APCLBD - beginning date to begin search for value - if blank, default is DOB

 ;   APCLED - ending date of search - if blank, default is DT

 ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801

 ;                                 A - return value:

 ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in

 I $G(APCLPDFN)="" Q ""

 I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 I $G(APCLED)="" S APCLED=DT

 I $G(APCLFORM)="" S APCLFORM="D"

 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E

 S APCLLAST=""

 S APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (SMOKELESS - CHEWING/DIP)",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")

D E

 S R=$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD)

 S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,R,APCLED,"BGP SMOKELESS TOBACCO CPTS","A")

D E

 S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"1320","ADA",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")

D E

 I APCLFORM="D" Q $P(APCLLAST,U)

 Q APCLLAST

LASTSMEX(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TOBACCO (EXPOSURE)

 ;  Return the last recorded TOBACCO SMOKING EXPOSURE SCREENING:

 ;   - V Health Factor in Category TOBACCO (EXPOSURE)

 ;  Input:

 ;   APCLPDFN - Patient DFN

 ;   APCLBD - beginning date to begin search for value - if blank, default is DOB

 ;   APCLED - ending date of search - if blank, default is DT

 ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801

 ;                                 A - return value:

 ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in

 I $G(APCLPDFN)="" Q ""

 I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 I $G(APCLED)="" S APCLED=DT

 I $G(APCLFORM)="" S APCLFORM="D"

 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E

 S APCLLAST=""

 S APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (EXPOSURE)",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")

D E

 S R=$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD)

 I APCLFORM="D" Q $P(APCLLAST,U)

 Q APCLLAST

PREFLANG(P,EDATE,F) ;EP - return the patient's preferred language as of date EDATE

 I '$G(P) Q ""

 I '$D(^AUPNPAT(P)) Q ""

 I '$O(^AUPNPAT(P,86,0)) Q ""  ;no language data

 I $G(F)="" S F="I"

 I $G(EDATE)="" S EDATE=DT

 NEW X,Y,D

 S (X,Y,D)=""

 F  S D=$O(^AUPNPAT(P,86,"B",D)) Q:D'=+D!(D>EDATE)  D

 .S X=0 F  S X=$O(^AUPNPAT(P,86,"B",D,X)) Q:X'=+X  D

 ..I $P(^AUPNPAT(P,86,X,0),U,4)]"" S Y=$P(^AUPNPAT(P,86,X,0),U,4)  ;preferred language documented

..Q

 I F="E" Q $S(Y:$P(^AUTTLANG(Y,0),U,1),1:"")

 I F="I" Q Y

Q Y

ETHN(P,F) ;EP

 I '$G(P) Q ""

 I $G(F)="" S F="E"

 I '$D(^DPT(P,0)) Q ""

 NEW Z,E,I

 S (E,I)=""

 S Z=0 F  S Z=$O(^DPT(P,.06,Z)) Q:Z'=+Z!(E]"")  D

 .S I=$P($G(^DPT(P,.06,Z,0)),U,1)

 .Q:I=""

 .S E=$P($G(^DIC(10.2,I,0)),U,1)

.Q

 I F="E" Q E

 I F="I" Q I

 Q ""

LASTNAA ;EP

 ;  Return the last recorded NO ACTIVE PROBLEMS FROM V UPDATED/REVIEWED:

 ;   .09 OF V UPDATED/REVIEWED is set to 1

 ;  Input:

 ;   APCLPDFN - Patient DFN

 ;   APCLBD - beginning date to begin search for value - if blank, default is DOB

 ;   APCLED - ending date of search - if blank, default is DT

 ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801

 ;                                 A - return value:

 ;                       date^text of item found^provider who documented^visit ien^File found in^ien of file found in

 ;             Default if blank is D

 ;  Output:

 ;   If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null

 ;   If APCLFORM is A returns the string:

 ;     date^text of item found^PROVIDER^visit ien^File found in^ien of file found in

 I $G(APCLPDFN)="" Q ""

 I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 I $G(APCLED)="" S APCLED=DT

 I $G(APCLFORM)="" S APCLFORM="D"

 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,D,G,ED,BD

 S BD=9999999-APCLBD

 S ED=9999999-APCLED

 S APCLLAST=""

 S V=$O(^AUTTCRA("C","NAA",0))

 I 'V Q ""

 S D=ED-1,D=D_".999999" F  S D=$O(^AUPNVRUP("AA",APCLPDFN,V,D)) Q:D'=+D!($P(D,".")>BD)  D

 .S X=0 F  S X=$O(^AUPNVRUP("AA",APCLPDFN,V,D,X)) Q:X'=+X  D

 ..Q:'$D(^AUPNVRUP(X,0))

 ..Q:$P($G(^AUPNVRUP(X,2)),U,1)

 ..S APCLVAL=$P($P(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$P($G(^AUPNVRUP(X,12)),U,4)_U_$P(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X

 ..D E

 I APCLFORM="D" Q $P(APCLLAST,U)

 Q APCLLAST

DEFEDD(P) ;PEP - return definitive EDD Date^definitive EDD type

 I '$G(P) Q ""  ;no patient

 I '$D(^AUPNREP(P,0)) Q ""  ;NOT IN RF

 NEW X,Y

 Q:$$VALI^XBDIQ1(9000017,P,1311)

 ;I X="" Q ""  ;no definitive EDD documented

 ;I X="L" Q $$VAL^XBDIQ1(9000017,P,1302)_U_$$VAL^XBDIQ1(9000017,P,1311)

 ;I X="U" Q $$VAL^XBDIQ1(9000017,P,1305)_U_$$VAL^XBDIQ1(9000017,P,1311)

 ;I X="C" Q $$VAL^XBDIQ1(9000017,P,1308)_U_$$VAL^XBDIQ1(9000017,P,1311)

 ;Q ""

LASTEDD(P) ;PEP - LAST DOCUMENTED EDD

 I '$G(P) Q ""  ;no patient

 I '$D(^AUPNREP(P,0)) Q ""  ;NOT IN RF

 NEW X,Y,LAST,LASTDOC

 S (LAST,LASTDOC)=""

 S X=$P($G(^AUPNREP(P,13)),U,3) I X S LASTDOC=X,LAST=$P($G(^AUPNREP(P,13)),U,2)_U_"(BY LMP)"  ;LMP

 S X=$P($G(^AUPNREP(P,13)),U,6)

 I X,X'<LASTDOC S LASTDOC=X,LAST=$P($G(^AUPNREP(P,13)),U,5)_U_"(BY ULTRASOUND)"

 S X=$P($G(^AUPNREP(P,13)),U,9)

 I X,X'<LASTDOC S LASTDOC=X,LAST=$P($G(^AUPNREP(P,13)),U,8)_U_"(BY CLINICAL PARAMETERS)"

 S X=$P($G(^AUPNREP(P,13)),U,15)

 I X,X'<LASTDOC S LASTDOC=X,LAST=$P($G(^AUPNREP(P,13)),U,14)_U_"(BY METHOD UNKNOWN)"

 S X=$P($G(^AUPNREP(P,13)),U,11)

 I X,X'<LASTDOC S LASTDOC=X,LAST=$P($G(^AUPNREP(P,13)),U,11)_U_"(DEFINITIVE)"

 Q LAST

APCLAPI7  ; IHS/CMI/LAB - visit data ; 15 Nov 2010  10:01 AM

 +1       ;;2.0;IHS PCC SUITE;**5,7**;MAY 14, 2009

 +2       ;IHS/TUCSON/LAB - added G parameter to provider call

 +3       ;

 +4       ;

 +5       ;

 +6       ;

VR        ;EP

 +1        SET APCLLAST=$PIECE(Y,U,1)_"^"_$PIECE($$CPT^ICPTCOD(Y),U,2)_" "_$$VAL^XBDIQ1(9000010.22,.01,X)_"^^"_$PIECE(^AUPNVRAD(X,0),U,3)_"^9000010.22^"_X

 +2        QUIT

 +3       ;

E         ;

 +1        IF $PIECE(APCLVAL,U,1)>$PIECE(APCLLAST,U,1)

               SET APCLLAST=APCLVAL

 +2        QUIT

LASTSMOK(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TOBACCO (SMOKING)

 +1       ;  Return the last recorded TOBACCO SMOKING SCREENING:

 +2       ;   - V Health Factor in Category TOBACCO (SMOKING)

 +3       ;   - V CPT [BGP SMOKING CPTS]

 +4       ;   - V POV [BGP GPRA SMOKING DXS]

 +5       ;   - V DENTAL ADA 1320

 +6       ;

 +7       ;  Input:

 +8       ;   APCLPDFN - Patient DFN

 +9       ;   APCLBD - beginning date to begin search for value - if blank, default is DOB

 +10      ;   APCLED - ending date of search - if blank, default is DT

 +11      ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801

 +12      ;                                 A - return value:

 +13      ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in

 +14      ;

 +15       IF $GET(APCLPDFN)=""

               QUIT ""

 +16       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +17       IF $GET(APCLED)=""

               SET APCLED=DT

 +18       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +19       NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E

 +20       SET APCLLAST=""

 +21       SET APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (SMOKING)",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +22       DO E

 +23       SET R=$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD)

 +24       SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,R,APCLED,"APCL TOBACCO (SMOKING) CPTS","A")

 +25       DO E

 +26       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"1320","ADA",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +27       DO E

 +28       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"[BGP GPRA SMOKING DXS","DX",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +29       DO E

 +30       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +31       QUIT APCLLAST

 +32      ;

LASTSMLE(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TOBACCO (SMOKING)

 +1       ;  Return the last recorded TOBACCO SMOKING SCREENING:

 +2       ;   - V Health Factor in Category TOBACCO (SMOKLESS - CHEWING/DIP)

 +3       ;   - V CPT [BGP SMOKELESS TOBACCO CPTS]

 +4       ;   - V DENTAL ADA 1320

 +5       ;

 +6       ;  Input:

 +7       ;   APCLPDFN - Patient DFN

 +8       ;   APCLBD - beginning date to begin search for value - if blank, default is DOB

 +9       ;   APCLED - ending date of search - if blank, default is DT

 +10      ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801

 +11      ;                                 A - return value:

 +12      ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in

 +13      ;

 +14       IF $GET(APCLPDFN)=""

               QUIT ""

 +15       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +16       IF $GET(APCLED)=""

               SET APCLED=DT

 +17       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +18       NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E

 +19       SET APCLLAST=""

 +20       SET APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (SMOKELESS - CHEWING/DIP)",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +21       DO E

 +22       SET R=$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD)

 +23       SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,R,APCLED,"BGP SMOKELESS TOBACCO CPTS","A")

 +24       DO E

 +25       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"1320","ADA",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +26       DO E

 +27       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +28       QUIT APCLLAST

 +29      ;

LASTSMEX(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TOBACCO (EXPOSURE)

 +1       ;  Return the last recorded TOBACCO SMOKING EXPOSURE SCREENING:

 +2       ;   - V Health Factor in Category TOBACCO (EXPOSURE)

 +3       ;

 +4       ;  Input:

 +5       ;   APCLPDFN - Patient DFN

 +6       ;   APCLBD - beginning date to begin search for value - if blank, default is DOB

 +7       ;   APCLED - ending date of search - if blank, default is DT

 +8       ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801

 +9       ;                                 A - return value:

 +10      ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in

 +11      ;

 +12       IF $GET(APCLPDFN)=""

               QUIT ""

 +13       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +14       IF $GET(APCLED)=""

               SET APCLED=DT

 +15       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +16       NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E

 +17       SET APCLLAST=""

 +18       SET APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (EXPOSURE)",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +19       DO E

 +20       SET R=$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD)

 +21       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +22       QUIT APCLLAST

 +23      ;

PREFLANG(P,EDATE,F) ;EP - return the patient's preferred language as of date EDATE

 +1        IF '$GET(P)

               QUIT ""

 +2        IF '$DATA(^AUPNPAT(P))

               QUIT ""

 +3       ;no language data

           IF '$ORDER(^AUPNPAT(P,86,0))

               QUIT ""

 +4        IF $GET(F)=""

               SET F="I"

 +5        IF $GET(EDATE)=""

               SET EDATE=DT

 +6        NEW X,Y,D

 +7        SET (X,Y,D)=""

 +8        FOR

               SET D=$ORDER(^AUPNPAT(P,86,"B",D))

               IF D'=+D!(D>EDATE)

                   QUIT

               Begin DoDot:1

 +9                SET X=0

FOR

                       SET X=$ORDER(^AUPNPAT(P,86,"B",D,X))

                       IF X'=+X

                           QUIT

                       Begin DoDot:2

 +10      ;preferred language documented

                           IF $PIECE(^AUPNPAT(P,86,X,0),U,4)]""

                               SET Y=$PIECE(^AUPNPAT(P,86,X,0),U,4)

 +11                       QUIT

                       End DoDot:2

               End DoDot:1

 +12       IF F="E"

               QUIT $SELECT(Y:$PIECE(^AUTTLANG(Y,0),U,1),1:"")

 +13       IF F="I"

               QUIT Y

 +14       QUIT Y

ETHN(P,F) ;EP

 +1        IF '$GET(P)

               QUIT ""

 +2        IF $GET(F)=""

               SET F="E"

 +3        IF '$DATA(^DPT(P,0))

               QUIT ""

 +4        NEW Z,E,I

 +5        SET (E,I)=""

 +6        SET Z=0

FOR

               SET Z=$ORDER(^DPT(P,.06,Z))

               IF Z'=+Z!(E]"")

                   QUIT

               Begin DoDot:1

 +7                SET I=$PIECE($GET(^DPT(P,.06,Z,0)),U,1)

 +8                IF I=""

                       QUIT

 +9                SET E=$PIECE($GET(^DIC(10.2,I,0)),U,1)

 +10               QUIT

               End DoDot:1

 +11       IF F="E"

               QUIT E

 +12       IF F="I"

               QUIT I

 +13       QUIT ""

LASTNAA   ;EP

 +1       ;  Return the last recorded NO ACTIVE PROBLEMS FROM V UPDATED/REVIEWED:

 +2       ;   .09 OF V UPDATED/REVIEWED is set to 1

 +3       ;

 +4       ;  Input:

 +5       ;   APCLPDFN - Patient DFN

 +6       ;   APCLBD - beginning date to begin search for value - if blank, default is DOB

 +7       ;   APCLED - ending date of search - if blank, default is DT

 +8       ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801

 +9       ;                                 A - return value:

 +10      ;                       date^text of item found^provider who documented^visit ien^File found in^ien of file found in

 +11      ;             Default if blank is D

 +12      ;  Output:

 +13      ;   If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null

 +14      ;   If APCLFORM is A returns the string:

 +15      ;     date^text of item found^PROVIDER^visit ien^File found in^ien of file found in

 +16      ;

 +17       IF $GET(APCLPDFN)=""

               QUIT ""

 +18       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +19       IF $GET(APCLED)=""

               SET APCLED=DT

 +20       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +21       NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,D,G,ED,BD

 +22       SET BD=9999999-APCLBD

 +23       SET ED=9999999-APCLED

 +24       SET APCLLAST=""

 +25       SET V=$ORDER(^AUTTCRA("C","NAA",0))

 +26       IF 'V

               QUIT ""

 +27       SET D=ED-1

           SET D=D_".999999"

FOR

               SET D=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D))

               IF D'=+D!($PIECE(D,".")>BD)

                   QUIT

               Begin DoDot:1

 +28               SET X=0

FOR

                       SET X=$ORDER(^AUPNVRUP("AA",APCLPDFN,V,D,X))

                       IF X'=+X

                           QUIT

                       Begin DoDot:2

 +29                       IF '$DATA(^AUPNVRUP(X,0))

                               QUIT

 +30                       IF $PIECE($GET(^AUPNVRUP(X,2)),U,1)

                               QUIT

 +31                       SET APCLVAL=$PIECE($PIECE(^AUPNVRUP(X,12),U),".")_U_$$VAL^XBDIQ1(9000010.54,X,.01)_U_$PIECE($GET(^AUPNVRUP(X,12)),U,4)_U_$PIECE(^AUPNVRUP(X,0),U,3)_U_9000010.54_U_X

 +32                       DO E

                       End DoDot:2

               End DoDot:1

 +33       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +34       QUIT APCLLAST

 +35      ;

DEFEDD(P) ;PEP - return definitive EDD Date^definitive EDD type

 +1       ;no patient

           IF '$GET(P)

               QUIT ""

 +2       ;NOT IN RF

           IF '$DATA(^AUPNREP(P,0))

               QUIT ""

 +3        NEW X,Y

 +4        IF $$VALI^XBDIQ1(9000017,P,1311)

               QUIT

 +5       ;I X="" Q ""  ;no definitive EDD documented

 +6       ;I X="L" Q $$VAL^XBDIQ1(9000017,P,1302)_U_$$VAL^XBDIQ1(9000017,P,1311)

 +7       ;I X="U" Q $$VAL^XBDIQ1(9000017,P,1305)_U_$$VAL^XBDIQ1(9000017,P,1311)

 +8       ;I X="C" Q $$VAL^XBDIQ1(9000017,P,1308)_U_$$VAL^XBDIQ1(9000017,P,1311)

 +9       ;Q ""

LASTEDD(P) ;PEP - LAST DOCUMENTED EDD

 +1       ;no patient

           IF '$GET(P)

               QUIT ""

 +2       ;NOT IN RF

           IF '$DATA(^AUPNREP(P,0))

               QUIT ""

 +3        NEW X,Y,LAST,LASTDOC

 +4        SET (LAST,LASTDOC)=""

 +5       ;LMP

           SET X=$PIECE($GET(^AUPNREP(P,13)),U,3)

           IF X

               SET LASTDOC=X

               SET LAST=$PIECE($GET(^AUPNREP(P,13)),U,2)_U_"(BY LMP)"

 +6        SET X=$PIECE($GET(^AUPNREP(P,13)),U,6)

 +7        IF X

               IF X'<LASTDOC

                   SET LASTDOC=X

                   SET LAST=$PIECE($GET(^AUPNREP(P,13)),U,5)_U_"(BY ULTRASOUND)"

 +8        SET X=$PIECE($GET(^AUPNREP(P,13)),U,9)

 +9        IF X

               IF X'<LASTDOC

                   SET LASTDOC=X

                   SET LAST=$PIECE($GET(^AUPNREP(P,13)),U,8)_U_"(BY CLINICAL PARAMETERS)"

 +10       SET X=$PIECE($GET(^AUPNREP(P,13)),U,15)

 +11       IF X

               IF X'<LASTDOC

                   SET LASTDOC=X

                   SET LAST=$PIECE($GET(^AUPNREP(P,13)),U,14)_U_"(BY METHOD UNKNOWN)"

 +12       SET X=$PIECE($GET(^AUPNREP(P,13)),U,11)

 +13       IF X

               IF X'<LASTDOC

                   SET LASTDOC=X

                   SET LAST=$PIECE($GET(^AUPNREP(P,13)),U,11)_U_"(DEFINITIVE)"

 +14       QUIT LAST

APCLAPI7.m