APCLAPI1 ; IHS/CMI/LAB - visit data ; 02 Sep 2010 7:04 AM
;;2.0;IHS PCC SUITE;**2,5,7,10,11,16**;MAY 14, 2009;Build 9
;IHS/TUCSON/LAB - added G parameter to provider call
;
;
;BJPC v1.0 patch 1
;
LASTMAM(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last MAMMOGRAM
; Return the last recorded MAMMOGRAM:
; - V Radiology with CPT in BGP CPT MAMMOGRAM taxonomy
; - Diagnosis - V POV V76.11, V76.12
; - Procedures: 87.36, 87.37
; - V CPT: BGP CPT MAMMOGRAM taxonomy
; - Women's Health Procedures: MAMMOGRAM SCREENING, MAMMOGRAM DX UNILAT, MAMMOGRAM DX BILAT
;
; 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
S APCLLAST=""
S APCLVAL=$$LASTRADT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT MAMMOGRAM","A")
D E
S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP MAMMOGRAM 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=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP MAMMOGRAM PROCEDURES","A")
D E
;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"87.37","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 CPT MAMMOGRAM","A")
D E
;if wh v3.0 get date for last mammogram
;I $$VERSION^XPDUTL("BW")>2.9 F X="MAMMOGRAM SCREENING","MAMMOGRAM DX UNILATERAL","MAMMOGRAM DX BILATERAL","MAMMOGRAM, UNSPECIFIED" D
;.S T=$O(^BWVPDT("B",X,0))
;.S V=$$WHAPI^BWVPAT1(APCLPDFN,T)
;.I $P(V,U)=0 S $P(V,U)=""
;.Q:$P(APCLLAST,U)>$P(V,U)
;.S APCLLAST=$P(V,U)_"^WH: "_X_"^^^90515^"
;now check wh package directly
F X="MAMMOGRAM SCREENING","MAMMOGRAM DX UNILAT","MAMMOGRAM DX BILAT" D
.S T=$O(^BWPN("B",X,0))
.I T D
..S (G,V)=0 F S V=$O(^BWPCD("C",APCLPDFN,V)) Q:V=""!(G) D
...Q:'$D(^BWPCD(V,0))
...I $P(^BWPCD(V,0),U,4)'=T Q
...S D=$P(^BWPCD(V,0),U,12)
...Q:$P(APCLLAST,U)>D
...Q:D>APCLED
...Q:$$VAL^XBDIQ1(9002086.1,V,.05)="Error/disregard"
...S APCLLAST=D_"^WH: "_X_"^^^9002086.1^"_V
.Q
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
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
Q
;
E ;
I $P(APCLVAL,U,1)>$P(APCLLAST,U,1) S APCLLAST=APCLVAL
Q
;
LASTPAP(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PAP SMEAR
; Return the last recorded PAP SMEAR:
; - V Lab "PAP SMEAR" or in BGP PAP SMEAR TAX taxonomy
; - Diagnosis - in BGP PAP SMEAR DXS taxonomy
; - Procedures: 91.46
; - V CPT: BGP CPT PAP taxonomy
; - Women's Health Procedures: PAP SMEAR
;
; 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
S APCLLAST=""
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"[BGP PAP SMEAR TAX","LAB",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"PAP SMEAR","LAB",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"[BGP PAP SMEAR DXS","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A") ;REMOVED PER SUSAN ON 3/7/13
;D E
S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP PAP PROCEDURES","A")
D E
S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT PAP","A")
D E
;if wh v3.0 get date for last mammogram
;I $$VERSION^XPDUTL("BW")>2 F X="PAP SMEAR" D
;.S T=$O(^BWVPDT("B",X,0))
;.S V=$$WHAPI^BWVPAT1(APCLPDFN,T)
;.I $P(V,U)=0 S $P(V,U)=""
;.Q:$P(APCLLAST,U)>$P(V,U)
;.S APCLLAST=$P(V,U)_"^WH: "_X_"^^^90515^"
;now check wh package directly
F X="PAP SMEAR" D
.S T=$O(^BWPN("B",X,0))
.I T D
..S (G,V)=0 F S V=$O(^BWPCD("C",APCLPDFN,V)) Q:V=""!(G) D
...Q:'$D(^BWPCD(V,0))
...I $P(^BWPCD(V,0),U,4)'=T Q
...S D=$P(^BWPCD(V,0),U,12)
...Q:$P(APCLLAST,U)>D
...Q:D>APCLED
...Q:$$VAL^XBDIQ1(9002086.1,V,.05)="Error/disregard"
...S APCLLAST=D_"^WH: "_X_"^^^9002086.1^"_V
.Q
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTTOBS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TOBACCO USE SCREENING
;THIS HAS BEEN UPDATED TO LOOK AT 3 CATEGORIES OF TOBACCO HEALTH FACTORS, IF YOU JUST WANT
;SMOKING USE API LASTSMOK, IF YOU WANT LAST SMOKELESS USE LASTSMLE IF YOU WANT EXPOSURE USE
;LASTSMEX
; Return the last recorded TOBACCO USE SCREENING:
; - V Health Factor in Category TOBACCO (SMOKING), TOBACCO (SMOKELESS - CHEWING/DIP), TOBACCO (EXPOSURE)
; - V CPT 1034F, 1035F, 1036F
; - 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
; 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
S APCLLAST=""
S APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (SMOKING)",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (SMOKELESS - CHEWING/DIP)",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
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)
S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,R,APCLED,"BGP TOBACCO SCREEN 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=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP TOBACCO DXS","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTTON(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TONOMETRY
; Return the last recorded TONOMETRY:
; - V Exam - 26 TONOMETRY
; - V Measurement - TON
; - Procedures: 89.11, 95.26
; - V CPT: S0620, S0621, 92100, 92120, 92499
;
; 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
S APCLLAST=""
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,26,"EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"TON","MEASUREMENT",$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 TONOMETRY PROCS","A")
D E
S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"S0620;S0621;92100;92120;92499","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
;
LASTVAE(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last VISUAL ACUITY EXAM
; Return the last recorded VISUAL ACUITY EXAM:
; - V Exam - 19 VISION EXAM
; - V Measurement - VU - VISION UNCORRECTED or VC - VISION CORRECTED
; - Procedures: 95.09, 95.05
; - V CPT: 99172, 99173
; - V POV: V72.0
;
; 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
S APCLLAST=""
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,26,"EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"07","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
D E
S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"08","MEASUREMENT",$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 EYE EXAM DXS","A")
D E
S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH VISION EXAM PROCS","A")
D E
;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"95.09","PROCEDURE",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
;D E
S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"99172;99173","A")
D E
I APCLFORM="D" Q $P(APCLLAST,U)
Q APCLLAST
APCLAPI1 ; IHS/CMI/LAB - visit data ; 02 Sep 2010 7:04 AM
+1 ;;2.0;IHS PCC SUITE;**2,5,7,10,11,16**;MAY 14, 2009;Build 9
+2 ;IHS/TUCSON/LAB - added G parameter to provider call
+3 ;
+4 ;
+5 ;BJPC v1.0 patch 1
+6 ;
LASTMAM(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last MAMMOGRAM
+1 ; Return the last recorded MAMMOGRAM:
+2 ; - V Radiology with CPT in BGP CPT MAMMOGRAM taxonomy
+3 ; - Diagnosis - V POV V76.11, V76.12
+4 ; - Procedures: 87.36, 87.37
+5 ; - V CPT: BGP CPT MAMMOGRAM taxonomy
+6 ; - Women's Health Procedures: MAMMOGRAM SCREENING, MAMMOGRAM DX UNILAT, MAMMOGRAM DX BILAT
+7 ;
+8 ; Input:
+9 ; APCLPDFN - Patient DFN
+10 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+11 ; APCLED - ending date of search - if blank, default is DT
+12 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+13 ; A - return value:
+14 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+15 ; Default if blank is D
+16 ; Output:
+17 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+18 ; If APCLFORM is A returns the string:
+19 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+20 ;
+21 IF $GET(APCLPDFN)=""
QUIT ""
+22 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+23 IF $GET(APCLED)=""
SET APCLED=DT
+24 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+25 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E
+26 SET APCLLAST=""
+27 SET APCLVAL=$$LASTRADT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT MAMMOGRAM","A")
+28 DO E
+29 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP MAMMOGRAM DXS","A")
+30 DO E
+31 ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V76.12","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
+32 ;D E
+33 SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP MAMMOGRAM PROCEDURES","A")
+34 DO E
+35 ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"87.37","PROCEDURE",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
+36 ;D E
+37 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT MAMMOGRAM","A")
+38 DO E
+39 ;if wh v3.0 get date for last mammogram
+40 ;I $$VERSION^XPDUTL("BW")>2.9 F X="MAMMOGRAM SCREENING","MAMMOGRAM DX UNILATERAL","MAMMOGRAM DX BILATERAL","MAMMOGRAM, UNSPECIFIED" D
+41 ;.S T=$O(^BWVPDT("B",X,0))
+42 ;.S V=$$WHAPI^BWVPAT1(APCLPDFN,T)
+43 ;.I $P(V,U)=0 S $P(V,U)=""
+44 ;.Q:$P(APCLLAST,U)>$P(V,U)
+45 ;.S APCLLAST=$P(V,U)_"^WH: "_X_"^^^90515^"
+46 ;now check wh package directly
+47 FOR X="MAMMOGRAM SCREENING","MAMMOGRAM DX UNILAT","MAMMOGRAM DX BILAT"
Begin DoDot:1
+48 SET T=$ORDER(^BWPN("B",X,0))
+49 IF T
Begin DoDot:2
+50 SET (G,V)=0
FOR
SET V=$ORDER(^BWPCD("C",APCLPDFN,V))
IF V=""!(G)
QUIT
Begin DoDot:3
+51 IF '$DATA(^BWPCD(V,0))
QUIT
+52 IF $PIECE(^BWPCD(V,0),U,4)'=T
QUIT
+53 SET D=$PIECE(^BWPCD(V,0),U,12)
+54 IF $PIECE(APCLLAST,U)>D
QUIT
+55 IF D>APCLED
QUIT
+56 IF $$VAL^XBDIQ1(9002086.1,V,.05)="Error/disregard"
QUIT
+57 SET APCLLAST=D_"^WH: "_X_"^^^9002086.1^"_V
End DoDot:3
End DoDot:2
+58 QUIT
End DoDot:1
+59 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+60 QUIT APCLLAST
+61 ;
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
+3 ;
LASTPAP(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PAP SMEAR
+1 ; Return the last recorded PAP SMEAR:
+2 ; - V Lab "PAP SMEAR" or in BGP PAP SMEAR TAX taxonomy
+3 ; - Diagnosis - in BGP PAP SMEAR DXS taxonomy
+4 ; - Procedures: 91.46
+5 ; - V CPT: BGP CPT PAP taxonomy
+6 ; - Women's Health Procedures: PAP SMEAR
+7 ;
+8 ; Input:
+9 ; APCLPDFN - Patient DFN
+10 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+11 ; APCLED - ending date of search - if blank, default is DT
+12 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+13 ; A - return value:
+14 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+15 ; Default if blank is D
+16 ; Output:
+17 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+18 ; If APCLFORM is A returns the string:
+19 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+20 ;
+21 IF $GET(APCLPDFN)=""
QUIT ""
+22 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+23 IF $GET(APCLED)=""
SET APCLED=DT
+24 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+25 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E
+26 SET APCLLAST=""
+27 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"[BGP PAP SMEAR TAX","LAB",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+28 DO E
+29 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"PAP SMEAR","LAB",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+30 DO E
+31 ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"[BGP PAP SMEAR DXS","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A") ;REMOVED PER SUSAN ON 3/7/13
+32 ;D E
+33 SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP PAP PROCEDURES","A")
+34 DO E
+35 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT PAP","A")
+36 DO E
+37 ;if wh v3.0 get date for last mammogram
+38 ;I $$VERSION^XPDUTL("BW")>2 F X="PAP SMEAR" D
+39 ;.S T=$O(^BWVPDT("B",X,0))
+40 ;.S V=$$WHAPI^BWVPAT1(APCLPDFN,T)
+41 ;.I $P(V,U)=0 S $P(V,U)=""
+42 ;.Q:$P(APCLLAST,U)>$P(V,U)
+43 ;.S APCLLAST=$P(V,U)_"^WH: "_X_"^^^90515^"
+44 ;now check wh package directly
+45 FOR X="PAP SMEAR"
Begin DoDot:1
+46 SET T=$ORDER(^BWPN("B",X,0))
+47 IF T
Begin DoDot:2
+48 SET (G,V)=0
FOR
SET V=$ORDER(^BWPCD("C",APCLPDFN,V))
IF V=""!(G)
QUIT
Begin DoDot:3
+49 IF '$DATA(^BWPCD(V,0))
QUIT
+50 IF $PIECE(^BWPCD(V,0),U,4)'=T
QUIT
+51 SET D=$PIECE(^BWPCD(V,0),U,12)
+52 IF $PIECE(APCLLAST,U)>D
QUIT
+53 IF D>APCLED
QUIT
+54 IF $$VAL^XBDIQ1(9002086.1,V,.05)="Error/disregard"
QUIT
+55 SET APCLLAST=D_"^WH: "_X_"^^^9002086.1^"_V
End DoDot:3
End DoDot:2
+56 QUIT
End DoDot:1
+57 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+58 QUIT APCLLAST
+59 ;
LASTTOBS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TOBACCO USE SCREENING
+1 ;THIS HAS BEEN UPDATED TO LOOK AT 3 CATEGORIES OF TOBACCO HEALTH FACTORS, IF YOU JUST WANT
+2 ;SMOKING USE API LASTSMOK, IF YOU WANT LAST SMOKELESS USE LASTSMLE IF YOU WANT EXPOSURE USE
+3 ;LASTSMEX
+4 ; Return the last recorded TOBACCO USE SCREENING:
+5 ; - V Health Factor in Category TOBACCO (SMOKING), TOBACCO (SMOKELESS - CHEWING/DIP), TOBACCO (EXPOSURE)
+6 ; - V CPT 1034F, 1035F, 1036F
+7 ; - V POV [BGP GPRA SMOKING DXS]
+8 ; - V DENTAL ADA 1320
+9 ;
+10 ; Input:
+11 ; APCLPDFN - Patient DFN
+12 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+13 ; APCLED - ending date of search - if blank, default is DT
+14 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+15 ; A - return value:
+16 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+17 ; Default if blank is D
+18 ; Output:
+19 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+20 ; If APCLFORM is A returns the string:
+21 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+22 ;
+23 IF $GET(APCLPDFN)=""
QUIT ""
+24 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+25 IF $GET(APCLED)=""
SET APCLED=DT
+26 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+27 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E
+28 SET APCLLAST=""
+29 SET APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (SMOKING)",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+30 DO E
+31 SET APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (SMOKELESS - CHEWING/DIP)",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+32 DO E
+33 SET APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (EXPOSURE)",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+34 DO E
+35 SET R=$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD)
+36 SET APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,R,APCLED,"BGP TOBACCO SCREEN CPTS","A")
+37 DO E
+38 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"1320","ADA",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+39 DO E
+40 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP TOBACCO DXS","A")
+41 DO E
+42 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+43 QUIT APCLLAST
+44 ;
LASTTON(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TONOMETRY
+1 ; Return the last recorded TONOMETRY:
+2 ; - V Exam - 26 TONOMETRY
+3 ; - V Measurement - TON
+4 ; - Procedures: 89.11, 95.26
+5 ; - V CPT: S0620, S0621, 92100, 92120, 92499
+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
+25 SET APCLLAST=""
+26 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,26,"EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+27 DO E
+28 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"TON","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+29 DO E
+30 SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH TONOMETRY PROCS","A")
+31 DO E
+32 SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"S0620;S0621;92100;92120;92499","A")
+33 DO E
+34 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+35 QUIT APCLLAST
+36 ;
LASTVAE(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last VISUAL ACUITY EXAM
+1 ; Return the last recorded VISUAL ACUITY EXAM:
+2 ; - V Exam - 19 VISION EXAM
+3 ; - V Measurement - VU - VISION UNCORRECTED or VC - VISION CORRECTED
+4 ; - Procedures: 95.09, 95.05
+5 ; - V CPT: 99172, 99173
+6 ; - V POV: V72.0
+7 ;
+8 ; Input:
+9 ; APCLPDFN - Patient DFN
+10 ; APCLBD - beginning date to begin search for value - if blank, default is DOB
+11 ; APCLED - ending date of search - if blank, default is DT
+12 ; APCLFORM - APCLFORM returned: D - return date only - example 3070801
+13 ; A - return value:
+14 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+15 ; Default if blank is D
+16 ; Output:
+17 ; If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
+18 ; If APCLFORM is A returns the string:
+19 ; date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
+20 ;
+21 IF $GET(APCLPDFN)=""
QUIT ""
+22 IF $GET(APCLBD)=""
SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)
+23 IF $GET(APCLED)=""
SET APCLED=DT
+24 IF $GET(APCLFORM)=""
SET APCLFORM="D"
+25 NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E
+26 SET APCLLAST=""
+27 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,26,"EXAM",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+28 DO E
+29 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"07","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+30 DO E
+31 SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"08","MEASUREMENT",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")
+32 DO E
+33 SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP EYE EXAM DXS","A")
+34 DO E
+35 SET APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"APCH VISION EXAM PROCS","A")
+36 DO E
+37 ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"95.09","PROCEDURE",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
+38 ;D E
+39 SET APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"99172;99173","A")
+40 DO E
+41 IF APCLFORM="D"
QUIT $PIECE(APCLLAST,U)
+42 QUIT APCLLAST
