APCLAPI4.m

APCLAPI4 ; IHS/CMI/LAB - visit data ; 

 ;;2.0;IHS PCC SUITE;**2,5,7,11,16**;MAY 14, 2009;Build 9

 ;

 ;

 ;

LASTTD(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TD

 ;  Return the last recorded TD:

 ;   - V Immunization: 1, 9, 20, 22, 28, 35, 50, 106, 107, 110, 112, 113, 115

 ;   - V CPT [APCH TD CPTS]

 ;

 ;  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

 ;             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^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,T,G,APCLY,APCLF

 S APCLLAST=""

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

 S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH TD CPTS","A")

 D E

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

 Q APCLLAST

 ;

E ;

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

 Q

 ;

 ;

LASTPNEU(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PNEUMOVAX

 ;  Return the last recorded PNEUMOVAX:

 ;   - V Immunization: 33, 100, 109

 ;   - V POV V06.6, V03.82

 ;   - V PROCEDURE 99.55

 ;   - V CPT [BGP PNEUMO IZ CPTS]

 ;

 ;  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

 ;             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^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,T,G,APCLY,APCLF

 S APCLLAST=""

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

 D E

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

 D E

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

 D E

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

 D E

 S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP PNEUMO IZ DXS","A")

 D E

 S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP PNEUMO IZ PROCEDURES","A")

 D E

 S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP PNEUMO IZ CPTS","A")

 D E

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

 Q APCLLAST

 ;

LASTFLU(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last FLU

 ;  Return the last recorded FLU:

 ;   - V Immunization: 15, 16, 88, 111

 ;   - V POV V06.6, V04.81

 ;   - V PROCEDURE 99.52

 ;   - V CPT [BGP CPT FLU]

 ;

 ;  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

 ;             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^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,T,G,APCLY,APCLF

 S APCLLAST=""

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

 S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP FLU IZ DXS","A")

 D E

 S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP FLU IZ PROCEDURES","A")

 D E

 S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT FLU","A")

 D E

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

 Q APCLLAST

 ;

LASTBE(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last BARIUM ENEMA

 ;  Return the last recorded BARIUM ENEMA:

 ;   - V Radiology [BGP BE CPTS]

 ;   - V CPT [BGP BE CPTS]

 ;

 ;  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

 ;             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^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,T,G,APCLY,APCLF

 S APCLLAST=""

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

 ;D E

 S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP BE CPTS","A")

 D E

 S APCLVAL=$$LASTRADT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP BE CPTS","A")

 D E

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

 Q APCLLAST

 ;

LASTOST(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last OSTEOPOROSIS SCREENING

 ;  Return the last recorded OSTEOPOROSIS SCREENING:

 ;   - V POV V82.81

 ;   - V PROCEDURE 88.98

 ;   - V CPT OR V READ [BGP OSTEO SCREEN CPTS]

 ;

 ;  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

 ;             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^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,T,G,APCLY,APCLF

 S APCLLAST=""

 S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP OSTEOPOROSIS SCRN DXS","A")

 D E

 S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP OSTEOPOROSIS SCREEN PROCS","A")

 D E

 S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP OSTEO SCREEN CPTS","A")

 D E

 S APCLVAL=$$LASTRADT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP OSTEO SCREEN CPTS","A")

 D E

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

 Q APCLLAST

 ;

LASTAOF(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last ASSESSMENT FUNCTION

 ;  Return the last recorded ASSESSMENT OF FUNCTION:

 ;   - V ELDER ENTRY

 ;

 ;  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

 ;             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^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,T,G,APCLY,APCLF

 S APCLLAST=""

 S APCLVAL=0 F  S APCLVAL=$O(^AUPNVELD("AA",APCLPDFN,APCLVAL)) Q:APCLVAL'=+APCLVAL!(APCLLAST)  D

 .S APCLX=0 F  S APCLX=$O(^AUPNVELD("AA",APCLPDFN,APCLVAL,APCLX)) Q:APCLX'=+APCLX!(APCLLAST)  D

 ..;Q:$P($G(^AUPNVELD(APCLX,0)),U,17)=""  ;no change in functional status

 ..Q:'$D(^AUPNVELD(APCLX,0))

 ..S G=0 F X=1:1:18 I $P(^AUPNVELD(APCLX,0),U,X)]"" S G=1

 ..Q:'G

 ..S APCLLAST=(9999999-APCLVAL)_"^Elder Care entry^"_$P(^AUPNVELD(APCLX,0),U,17)_"^"_$P(^AUPNVELD(APCLX,0),U,3)_"^9000010.35^"_APCLX

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

 Q APCLLAST

 ;

INRDX(P,V,BD,ED) ;PEP - does patient P have a dx in BJPC AC THRPY INDIC DXS taxonomy

 ; P - DFN

 ; V - VISIT IEN

 ; BD - Beginning date for dx search

 ; ED - ending date for dx search

 ; caller can pass in V and just that visit will be examined for a diagnosis

 ; called can pass in BD and ED to determine what date range will be used for dx search

 ; V overrides BD and ED so if V is passed and BD and ED are passed, BD and ED will be ignored

 ; If V is null and BD and ED are null then DOB and DT are used

 ; return value= 1^date of dx^ien of dx^dx code

 ;

 NEW T,R

 S T=$O(^ATXAX("B","BJPC AC THRPY INDIC DXS",0))

 I 'T Q ""

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

 S R=""

 I $G(V),$D(^AUPNVSIT(V,0)) G INRDXV

 I $G(BD)="" S BD=$$DOB^AUPNPAT(P)

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

 S R=$$LASTDXT^APCLAPIU(P,BD,ED,"BJPC AC THRPY INDIC DXS","A")

 I R]"" Q 1_"^"_$P(R,U,1)_"^"_$P(^AUPNVPOV($P(R,U,6),0),U)_"^"_$$VAL^XBDIQ1(9000010.07,$P(R,U,6),.01)

 Q ""

INRDXV ;

 NEW A,B

 S A=0 F  S A=$O(^AUPNVPOV("AD",V,A)) Q:A'=+A!(R]"")  D

 .Q:'$D(^AUPNVPOV(A,0))

 .S B=$P(^AUPNVPOV(A,0),U)

 .Q:'$$ICD^ATXAPI(B,T,9)

 .S R=1_"^"_$$VD^APCLV(V)_"^"_$P(^AUPNVPOV(A,0),U)_"^"_$$VAL^XBDIQ1(9000010.07,A,.01)

 Q R

APCLAPI4  ; IHS/CMI/LAB - visit data ; 

 +1       ;;2.0;IHS PCC SUITE;**2,5,7,11,16**;MAY 14, 2009;Build 9

 +2       ;

 +3       ;

 +4       ;

LASTTD(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TD

 +1       ;  Return the last recorded TD:

 +2       ;   - V Immunization: 1, 9, 20, 22, 28, 35, 50, 106, 107, 110, 112, 113, 115

 +3       ;   - V CPT [APCH TD CPTS]

 +4       ;

 +5       ;  Input:

 +6       ;   APCLPDFN - Patient DFN

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

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

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

 +10      ;                                 A - return value:

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

 +12      ;             Default if blank is D

 +13      ;  Output:

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

 +15      ;   If APCLFORM is A returns the string:

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

 +17      ; 

 +18       IF $GET(APCLPDFN)=""

               QUIT ""

 +19       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +20       IF $GET(APCLED)=""

               SET APCLED=DT

 +21       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +22       NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF

 +23       SET APCLLAST=""

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

 +25       DO E

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

 +27       DO E

 +28       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"20","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +29       DO E

 +30       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"22","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +31       DO E

 +32       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"28","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +33       DO E

 +34       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"35","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +35       DO E

 +36       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"50","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +37       DO E

 +38       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"106","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +39       DO E

 +40       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"107","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +41       DO E

 +42       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"110","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +43       DO E

 +44       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"112","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +45       DO E

 +46       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"113","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +47       DO E

 +48       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"115","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +49       DO E

 +50       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"120","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +51       DO E

 +52       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"130","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +53       DO E

 +54       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"132","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +55       DO E

 +56       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"138","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +57       DO E

 +58       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"139","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +59       DO E

 +60       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"142","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +61       DO E

 +62       SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH TD CPTS","A")

 +63       DO E

 +64       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +65       QUIT APCLLAST

 +66      ;

E         ;

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

               SET APCLLAST=APCLVAL

 +2        QUIT 

 +3       ;

 +4       ;

LASTPNEU(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PNEUMOVAX

 +1       ;  Return the last recorded PNEUMOVAX:

 +2       ;   - V Immunization: 33, 100, 109

 +3       ;   - V POV V06.6, V03.82

 +4       ;   - V PROCEDURE 99.55

 +5       ;   - V CPT [BGP PNEUMO IZ CPTS]

 +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      ;             Default if blank is D

 +15      ;  Output:

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

 +17      ;   If APCLFORM is A returns the string:

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

 +19      ; 

 +20       IF $GET(APCLPDFN)=""

               QUIT ""

 +21       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +22       IF $GET(APCLED)=""

               SET APCLED=DT

 +23       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +24       NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF

 +25       SET APCLLAST=""

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

 +27       DO E

 +28       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"100","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +29       DO E

 +30       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"109","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +31       DO E

 +32       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"133","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +33       DO E

 +34       SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP PNEUMO IZ DXS","A")

 +35       DO E

 +36       SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP PNEUMO IZ PROCEDURES","A")

 +37       DO E

 +38       SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP PNEUMO IZ CPTS","A")

 +39       DO E

 +40       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +41       QUIT APCLLAST

 +42      ;

LASTFLU(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last FLU

 +1       ;  Return the last recorded FLU:

 +2       ;   - V Immunization: 15, 16, 88, 111

 +3       ;   - V POV V06.6, V04.81

 +4       ;   - V PROCEDURE 99.52

 +5       ;   - V CPT [BGP CPT FLU]

 +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      ;             Default if blank is D

 +15      ;  Output:

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

 +17      ;   If APCLFORM is A returns the string:

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

 +19      ; 

 +20       IF $GET(APCLPDFN)=""

               QUIT ""

 +21       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +22       IF $GET(APCLED)=""

               SET APCLED=DT

 +23       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +24       NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF

 +25       SET APCLLAST=""

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

 +27       DO E

 +28       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"15","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +29       DO E

 +30       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"16","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +31       DO E

 +32       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"111","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +33       DO E

 +34       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"135","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +35       DO E

 +36       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"140","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +37       DO E

 +38       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"141","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +39       DO E

 +40       SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"144","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +41       DO E

 +42       SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP FLU IZ DXS","A")

 +43       DO E

 +44       SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP FLU IZ PROCEDURES","A")

 +45       DO E

 +46       SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT FLU","A")

 +47       DO E

 +48       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +49       QUIT APCLLAST

 +50      ;

LASTBE(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last BARIUM ENEMA

 +1       ;  Return the last recorded BARIUM ENEMA:

 +2       ;   - V Radiology [BGP BE CPTS]

 +3       ;   - V CPT [BGP BE CPTS]

 +4       ;

 +5       ;  Input:

 +6       ;   APCLPDFN - Patient DFN

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

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

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

 +10      ;                                 A - return value:

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

 +12      ;             Default if blank is D

 +13      ;  Output:

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

 +15      ;   If APCLFORM is A returns the string:

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

 +17      ; 

 +18       IF $GET(APCLPDFN)=""

               QUIT ""

 +19       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +20       IF $GET(APCLED)=""

               SET APCLED=DT

 +21       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +22       NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF

 +23       SET APCLLAST=""

 +24      ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"87.64","PROCEDURE",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")

 +25      ;D E

 +26       SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP BE CPTS","A")

 +27       DO E

 +28       SET APCLVAL=$$LASTRADT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP BE CPTS","A")

 +29       DO E

 +30       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +31       QUIT APCLLAST

 +32      ;

LASTOST(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last OSTEOPOROSIS SCREENING

 +1       ;  Return the last recorded OSTEOPOROSIS SCREENING:

 +2       ;   - V POV V82.81

 +3       ;   - V PROCEDURE 88.98

 +4       ;   - V CPT OR V READ [BGP OSTEO SCREEN CPTS]

 +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      ;             Default if blank is D

 +14      ;  Output:

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

 +16      ;   If APCLFORM is A returns the string:

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

 +18      ; 

 +19       IF $GET(APCLPDFN)=""

               QUIT ""

 +20       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +21       IF $GET(APCLED)=""

               SET APCLED=DT

 +22       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +23       NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E,T,G,APCLY,APCLF

 +24       SET APCLLAST=""

 +25       SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP OSTEOPOROSIS SCRN DXS","A")