APCLAPI3 ; IHS/CMI/LAB - visit data ;
;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58
;IHS/TUCSON/LAB - added G parameter to provider call
;
;
;BJPC v1.0 patch 1
;
LASTMMR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last MMR
; Return the last recorded MMR:
; - V Immunization: 3, 94
; - V POV V06.4
; - V Procedure 99.48
; - V CPT 90707;90710
;
; 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,"3","IMMUNIZATION",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"94","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 MMR IZ DXS","A")
D E
S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP MMR IZ PROCS","A")
D E
S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"90707;90710","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
;
LASTRUB(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last RUBELLA
; Return the last recorded RUBELLA:
; - V Immunization: 3,4,6,38,94
;
; 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,"3","IMMUNIZATION",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"94","IMMUNIZATION",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"6","IMMUNIZATION",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"4","IMMUNIZATION",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"38","IMMUNIZATION",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTEPS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last EPSDT
; Return the last recorded EPSDT:
; - V CPT
;
; 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="",APCLVAL=""
S APCLY=$$AGE^AUPNPAT(APCLPDFN,APCLED)
I APCLY<1 S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"99381;99391","A")
D E
I APCLY>0,APCLY<5 S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"99382;99392","A")
D E
I APCLY>4,APCLY<12 S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"99383;99393","A")
D E
I APCLY>11,APCLY<18 S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"99384;99394","A")
D E
I APCLY>17 S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"99385;99395","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTBRST(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last BREAST EXAM
; Return the last recorded BREAST EXAM:
; - V Exam 06
; - V POV V76.10, V76,12, V76.19
; - V Procedure 89.36
; - V CPT G0101
;
; 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,"06","EXAM",$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,"APCH BREAST EXAM DXS","A")
D E
;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V76.12","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
;D E
;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V76.19","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
;D E
S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH BREAST EXAM PROCS","A")
D E
S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"G0101","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTGLUC(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last GLUCOSE SCREENING
; Return the last recorded GLUCOSE SCREENING:
; - V Lab: DM AUDIT GLUCOSE TESTS TAX, APCH SCREENING GLUCOSE LOINC
; - V POV V77.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^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,"APCH DIABETES SCRN DXS","A")
D E
S APCLVAL=$$LASTLAB^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,,$O(^ATXLAB("B","DM AUDIT GLUCOSE TESTS TAX",0)),,$O(^ATXAX("B","APCH SCREENING GLUCOSE LOINC",0)),"A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTHEAR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last HEARING EXAM
; Return the last recorded HEARING EXAM:
; - V Exam 17,23,24
; - V POV V72.11, V72.19
; - V MEASUREMENT 09, 10
; - V CPT 92553, 92552, 92555, 92556
;
; 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,"17","EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"23","EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"24","EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"09","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"10","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V72.11","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
;D E
;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V72.19","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING EXAM DXS","A")
D E
S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING LOSS DXS","A")
D E
S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING SCREEN CPTS","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTFOBT(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last FOBT
; Return the last recorded FOBT:
; - V Lab: BGP GPRA FOB TESTS, BGP FOBT LOINC CODES
; - V CPT - BGP FOBT 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=$$LASTLAB^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,,$O(^ATXLAB("B","BGP GPRA FOB TESTS",0)),,$O(^ATXAX("B","BGP FOBT LOINC CODES",0)),"A")
D E
S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP FOBT CPTS","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTCHOL(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last CHOLESTEROL
; Return the last recorded CHOLESTEROL:
; - V Lab: DM AUDIT CHOLESTEROL TAX, "BGP TOTAL CHOLESTEROL LOINC
; - V CPT - 82465
;
; 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=$$LASTLAB^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,,$O(^ATXLAB("B","DM AUDIT CHOLESTEROL TAX",0)),,$O(^ATXAX("B","BGP TOTAL CHOLESTEROL LOINC",0)),"A")
D E
S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"82465","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
APCLAPI3 ; IHS/CMI/LAB - visit data ;
+1 ;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58
+2 ;IHS/TUCSON/LAB - added G parameter to provider call
+3 ;
+4 ;
+5 ;BJPC v1.0 patch 1
+6 ;
LASTMMR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last MMR
+1 ; Return the last recorded MMR:
+2 ; - V Immunization: 3, 94
+3 ; - V POV V06.4
+4 ; - V Procedure 99.48
+5 ; - V CPT 90707;90710
+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,"3","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+27 DO E
+28 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"94","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+29 DO E
+30 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP MMR IZ DXS","A")
+31 DO E
+32 SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP MMR IZ PROCS","A")
+33 DO E
+34 SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"90707;90710","A")
+35 DO E
+36 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+37 QUIT APCLLAST
+38 ;
E ;
+1 IF $PIECE(APCLVAL,U,1)>$PIECE(APCLLAST,U,1)
SET APCLLAST=APCLVAL
+2 QUIT
+3 ;
LASTRUB(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last RUBELLA
+1 ; Return the last recorded RUBELLA:
+2 ; - V Immunization: 3,4,6,38,94
+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=$$LASTITEM^APCLAPIU(APCLPDFN,"3","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+24 DO E
+25 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"94","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+26 DO E
+27 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"6","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+28 DO E
+29 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"4","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+30 DO E
+31 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"38","IMMUNIZATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+32 DO E
+33 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+34 QUIT APCLLAST
+35 ;
LASTEPS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last EPSDT
+1 ; Return the last recorded EPSDT:
+2 ; - V CPT
+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=""
SET APCLVAL=""
+23 SET APCLY=$$AGE^AUPNPAT(APCLPDFN,APCLED)
+24 IF APCLY<1
SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"99381;99391","A")
+25 DO E
+26 IF APCLY>0
IF APCLY<5
SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"99382;99392","A")
+27 DO E
+28 IF APCLY>4
IF APCLY<12
SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"99383;99393","A")
+29 DO E
+30 IF APCLY>11
IF APCLY<18
SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"99384;99394","A")
+31 DO E
+32 IF APCLY>17
SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"99385;99395","A")
+33 DO E
+34 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+35 QUIT APCLLAST
+36 ;
LASTBRST(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last BREAST EXAM
+1 ; Return the last recorded BREAST EXAM:
+2 ; - V Exam 06
+3 ; - V POV V76.10, V76,12, V76.19
+4 ; - V Procedure 89.36
+5 ; - V CPT G0101
+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,"06","EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+27 DO E
+28 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH BREAST EXAM DXS","A")
+29 DO E
+30 ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V76.12","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
+31 ;D E
+32 ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V76.19","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
+33 ;D E
+34 SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH BREAST EXAM PROCS","A")
+35 DO E
+36 SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"G0101","A")
+37 DO E
+38 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+39 QUIT APCLLAST
+40 ;
LASTGLUC(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last GLUCOSE SCREENING
+1 ; Return the last recorded GLUCOSE SCREENING:
+2 ; - V Lab: DM AUDIT GLUCOSE TESTS TAX, APCH SCREENING GLUCOSE LOINC
+3 ; - V POV V77.1
+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=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH DIABETES SCRN DXS","A")
+25 DO E
+26 SET APCLVAL=$$LASTLAB^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,,$ORDER(^ATXLAB("B","DM AUDIT GLUCOSE TESTS TAX",0)),,$ORDER(^ATXAX("B","APCH SCREENING GLUCOSE LOINC",0)),"A")
+27 DO E
+28 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+29 QUIT APCLLAST
+30 ;
LASTHEAR(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last HEARING EXAM
+1 ; Return the last recorded HEARING EXAM:
+2 ; - V Exam 17,23,24
+3 ; - V POV V72.11, V72.19
+4 ; - V MEASUREMENT 09, 10
+5 ; - V CPT 92553, 92552, 92555, 92556
+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,"17","EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+27 DO E
+28 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"23","EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+29 DO E
+30 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"24","EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+31 DO E
+32 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"09","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+33 DO E
+34 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"10","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+35 DO E
+36 ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V72.11","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
+37 ;D E
+38 ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V72.19","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
+39 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING EXAM DXS","A")
+40 DO E
+41 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING LOSS DXS","A")
+42 DO E
+43 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH HEARING SCREEN CPTS","A")
+44 DO E
+45 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+46 QUIT APCLLAST
+47 ;
LASTFOBT(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last FOBT
+1 ; Return the last recorded FOBT:
+2 ; - V Lab: BGP GPRA FOB TESTS, BGP FOBT LOINC CODES
+3 ; - V CPT - BGP FOBT 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=$$LASTLAB^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,,$ORDER(^ATXLAB("B","BGP GPRA FOB TESTS",0)),,$ORDER(^ATXAX("B","BGP FOBT LOINC CODES",0)),"A")
+25 DO E
+26 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP FOBT CPTS","A")
+27 DO E
+28 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+29 QUIT APCLLAST
+30 ;
LASTCHOL(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last CHOLESTEROL
+1 ; Return the last recorded CHOLESTEROL:
+2 ; - V Lab: DM AUDIT CHOLESTEROL TAX, "BGP TOTAL CHOLESTEROL LOINC
+3 ; - V CPT - 82465
+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=$$LASTLAB^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,,$ORDER(^ATXLAB("B","DM AUDIT CHOLESTEROL TAX",0)),,$ORDER(^ATXAX("B","BGP TOTAL CHOLESTEROL LOINC",0)),"A")
+25 DO E
+26 SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"82465","A")
+27 DO E
+28 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+29 QUIT APCLLAST
+30 ;
