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")
+26 DO E
+27 SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP OSTEOPOROSIS SCREEN PROCS","A")
+28 DO E
+29 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP OSTEO SCREEN CPTS","A")
+30 DO E
+31 SET APCLVAL=$$LASTRADT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP OSTEO SCREEN CPTS","A")
+32 DO E
+33 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+34 QUIT APCLLAST
+35 ;
LASTAOF(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last ASSESSMENT FUNCTION
+1 ; Return the last recorded ASSESSMENT OF FUNCTION:
+2 ; - V ELDER ENTRY
+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 ; 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^value if appropriate^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,T,G,APCLY,APCLF
+22 SET APCLLAST=""
+23 SET APCLVAL=0
FOR
SET APCLVAL=$ORDER(^AUPNVELD("AA",APCLPDFN,APCLVAL))
IF APCLVAL'=+APCLVAL!(APCLLAST)
QUIT
Begin DoDot:1
+24 SET APCLX=0
FOR
SET APCLX=$ORDER(^AUPNVELD("AA",APCLPDFN,APCLVAL,APCLX))
IF APCLX'=+APCLX!(APCLLAST)
QUIT
Begin DoDot:2
+25 ;Q:$P($G(^AUPNVELD(APCLX,0)),U,17)="" ;no change in functional status
+26 IF '$DATA(^AUPNVELD(APCLX,0))
QUIT
+27 SET G=0
FOR X=1:1:18
IF $PIECE(^AUPNVELD(APCLX,0),U,X)]""
SET G=1
+28 IF 'G
QUIT
+29 SET APCLLAST=(9999999-APCLVAL)_"^Elder Care entry^"_$PIECE(^AUPNVELD(APCLX,0),U,17)_"^"_$PIECE(^AUPNVELD(APCLX,0),U,3)_"^9000010.35^"_APCLX
End DoDot:2
End DoDot:1
+30 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+31 QUIT APCLLAST
+32 ;
INRDX(P,V,BD,ED) ;PEP - does patient P have a dx in BJPC AC THRPY INDIC DXS taxonomy
+1 ; P - DFN
+2 ; V - VISIT IEN
+3 ; BD - Beginning date for dx search
+4 ; ED - ending date for dx search
+5 ; caller can pass in V and just that visit will be examined for a diagnosis
+6 ; called can pass in BD and ED to determine what date range will be used for dx search
+7 ; V overrides BD and ED so if V is passed and BD and ED are passed, BD and ED will be ignored
+8 ; If V is null and BD and ED are null then DOB and DT are used
+9 ; return value= 1^date of dx^ien of dx^dx code
+10 ;
+11 NEW T,R
+12 SET T=$ORDER(^ATXAX("B","BJPC AC THRPY INDIC DXS",0))
+13 IF 'T
QUIT ""
+14 IF $GET(P)=""
QUIT ""
+15 SET R=""
+16 IF $GET(V)
IF $DATA(^AUPNVSIT(V,0))
GOTO INRDXV
+17 IF $GET(BD)=""
SET BD=$$DOB^AUPNPAT(P)
+18 IF $GET(ED)=""
SET ED=DT
+19 SET R=$$LASTDXT^APCLAPIU(P,BD,ED,"BJPC AC THRPY INDIC DXS","A")
+20 IF R]""
QUIT 1_"^"_$PIECE(R,U,1)_"^"_$PIECE(^AUPNVPOV($PIECE(R,U,6),0),U)_"^"_$$VAL^XBDIQ1(9000010.07,$PIECE(R,U,6),.01)
+21 QUIT ""
INRDXV ;
+1 NEW A,B
+2 SET A=0
FOR
SET A=$ORDER(^AUPNVPOV("AD",V,A))
IF A'=+A!(R]"")
QUIT
Begin DoDot:1
+3 IF '$DATA(^AUPNVPOV(A,0))
QUIT
+4 SET B=$PIECE(^AUPNVPOV(A,0),U)
+5 IF '$$ICD^ATXAPI(B,T,9)
QUIT
+6 SET R=1_"^"_$$VD^APCLV(V)_"^"_$PIECE(^AUPNVPOV(A,0),U)_"^"_$$VAL^XBDIQ1(9000010.07,A,.01)
End DoDot:1
+7 QUIT R
