APCLAPI.m

APCLAPI ; IHS/CMI/LAB - visit data ; 25 Feb 2011  11:02 AM

 ;;2.0;IHS PCC SUITE;**6,8,11,14,16**;MAY 14, 2009;Build 9

 ;

LASTALC(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last alcohol screen

 ;  Return the last recorded alcohol screening value:

 ;   - V Exam 35 or Behavioral Health Module Alcohol Screening

 ;   - V measurement AUDC, AUDT, CRFT

 ;   - Health Factor with Alcohol/Drug Category (CAGE)

 ;   - Diagnosis - V POV V79.1

 ;   - Education Topics - V EDUCATION or Behavioral Health Module

 ;     AOD-SCR

 ;     CD-SCR

 ;   - Behavioral Health Module Diagnosis (POV) of 29.1

 ;   - cpts in BGP ALCOHOL SCREENING CPTS taxonomy

 ;   - V POV snomed PXRM BQI ALCOHOL SCREENING

 ;     

 ;  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

 S APCLLAST=""

 S APCLVAL=$$LASTALCS(APCLPDFN,APCLBD,APCLED,"A")

 D E

 S APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"ALCOHOL/DRUG",$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 SCREEN FOR ALCOHOLISM DX","A")

 D E

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

 D E

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

 D E

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

 D E

 S APCLX=0 F  S APCLX=$O(^AUTTEDT("C","AOD-SCR",APCLX)) Q:APCLX'=+APCLX  D

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

 .D E

 S APCLX=0 F  S APCLX=$O(^AUTTEDT("C","CD-SCR",APCLX)) Q:APCLX'=+APCLX  D

 .S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"`"_APCLX,"EDUCATION",$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 ALCOHOL SCREENING CPTS","A")

 D E

 S APCLVAL=$$SNOMEDPV^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"PXRM BQI ALCOHOL SCREENING","A")

 D E

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

 D E

 S APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"AOD-SCR","A")

 D E

 S APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"CD-SCR","A")

 D E

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

 D E

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

 D E

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

 D E

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

 Q APCLLAST

 ;

VE(Y,F,T) ;EP

 Q $P(Y,U,1)_"^Exam: "_$P(Y,U,3)_"^"_$$VAL^XBDIQ1(9000010.13,+$P(Y,U,4),.04)_"^"_$P(Y,U,5)_"^9000010.13^"_+$P(Y,U,4)

 ;

LASTALCS(P,BD,ED,F) ;

 ;look for last exam in v exam or bh between bd and ed

 NEW %,E,D,V,X,G

 NEW APCLG,APCLX,APCLC,APCLV

 S %=P_"^LAST EXAM 35;DURING "_BD_"-"_ED,E=$$START1^APCLDF(%,"APCLG(")

 I $D(APCLG(1)) S APCLX(9999999-$P(APCLG(1),U))=$$VE(APCLG(1))

 ;AMHREC field

 S APCLC=0,APCLV=""

 S E=(9999999-BD),D=9999999-ED-1_".99" F  S D=$O(^AMHREC("AE",P,D)) Q:D'=+D!(APCLC)!($P(D,".")>E)  S V=0 F  S V=$O(^AMHREC("AE",P,D,V)) Q:V'=+V!(APCLC)  D

 .S X=$P($G(^AMHREC(V,14)),U,3)

 .I X="" Q  ;no test

 .I $E(X)="U" Q  ;don't count refusal here

 .I X="REF" Q

 .S G=9999999-$P(D,".")

 .Q:$D(APCLX($P(D,".")))

 .S APCLX($P(D,"."))=G_"^BH: ALCOHOL SCREENING^"_$$VAL^XBDIQ1(9002011,V,1403)_"^^9002011^"_V

 I $O(APCLX(0)) S G=$O(APCLX(0)) Q $S(F="D":$P(APCLX(G),U,1),1:APCLX(G))

 Q ""

 ;

E ;

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

 Q

 ;

LASTDEPS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - return last depression screen

 ;  Return the last recorded depression screening value:

 ;   - V Exam 36 or Behavioral Health Module Depression Screening

 ;   - Diagnosis - V POV V79.0

 ;   - Education Topics - V EDUCATION or Behavioral Health Module

 ;     DEP-SCR

 ;   - V Measurement PHQ2, PHQ9, PHQT

 ;   - Behavioral Health Module Diagnosis (POV) of 14.1

 ;   - Diagnosis in BGP MOOD DISORDERS taxonomy in V POV

 ;   - Diagnosis in BGP MOOD DISORDERS taxonomy in BH

 ;   - Problem Code of 14 or 15 in BH

 ;   - V POV snomed PXRM BQI DEPRESSION SCREENING

 ;     

 ;  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(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)

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

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

 NEW APCLLAST,APCLVAL,APCLX

 S APCLLAST=""

 S APCLVAL=$$LASTDEP(APCLPDFN,APCLBD,APCLED,"A")

 D E

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

 D E

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

 D E

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

 D E

 S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"PHQT","MEASUREMENT",$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 DEPRESSION SCREEN CPTS","A")

 D E

 S APCLX=0 F  S APCLX=$O(^AUTTEDT("C","DEP-SCR",APCLX)) Q:APCLX'=+APCLX  D

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

 .D E

 S APCLVAL=$$SNOMEDPV^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"PXRM BQI DEPRESSION SCREENING","A")

 D E

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

 D E

 S APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"DEP-SCR","A")

 D E

 ;now check for mood disorders

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

 D E

 S APCLVAL=$$LASTBHDT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP MOOD DISORDERS","A")

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 D E

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

 Q APCLLAST

 ;

LASTDEP(P,BD,ED,F) ;

 NEW %,E,D,V,X,G

 NEW APCLG,APCLX,APCLC,APCLV

 S %=P_"^LAST EXAM 36;DURING "_BD_"-"_ED,E=$$START1^APCLDF(%,"APCLG(")

 I $D(APCLG(1)) S APCLX(9999999-$P(APCLG(1),U))=$$VE(APCLG(1))

 ;now look at AMHREC

 S APCLC=0,APCLV=""

 S E=(9999999-BD),D=9999999-ED-1_".99" F  S D=$O(^AMHREC("AE",P,D)) Q:D'=+D!(APCLC)!($P(D,".")>E)  S V=0 F  S V=$O(^AMHREC("AE",P,D,V)) Q:V'=+V!(APCLC)  D

 .S X=$P($G(^AMHREC(V,14)),U,5)

 .I X="" Q  ;no test

 .I $E(X)="U" Q  ;don't count refusal here

 .I X="REF" Q

 .S G=9999999-$P(D,".")

 .Q:$D(APCLX($P(D,".")))

 .S APCLX($P(D,"."))=G_"^BH: DEPRESSION SCREENING^"_$$VAL^XBDIQ1(9002011,V,1405)_"^^9002011^"_V

 I $O(APCLX(0)) S G=$O(APCLX(0)) Q $S(F="D":$P(APCLX(G),U,1),1:APCLX(G))

 Q ""

 ;

LASTIPVS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last ipv screen

 ;   - V Exam 34 or Behavioral Health IPV Screening

 ;

 ;  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

 S APCLLAST=""

 S APCLVAL=$$LASTIPV(APCLPDFN,APCLBD,APCLED,"A")

 D E

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

 Q APCLLAST

 ;

LASTIPV(P,BD,ED,APCLF) ;

 NEW %,E,D,V,X,G

 NEW APCLG,APCLX,APCLC,APCLV

 S %=P_"^LAST EXAM 34;DURING "_BD_"-"_ED,E=$$START1^APCLDF(%,"APCLG(")

 I $D(APCLG(1)) S APCLX(9999999-$P(APCLG(1),U))=$$VE(APCLG(1))

 ;now look at AMHREC field

 S APCLC=0,APCLV=""

 S E=(9999999-BD),D=9999999-ED-1_".99" F  S D=$O(^AMHREC("AE",P,D)) Q:D'=+D!(APCLC)!($P(D,".")>E)  S V=0 F  S V=$O(^AMHREC("AE",P,D,V)) Q:V'=+V!(APCLC)  D

 .S X=$P($G(^AMHREC(V,14)),U,1)

 .I X="" Q

 .I $E(X)="U" Q  ;don't count refusal here

 .I X="REF" Q

 .S G=9999999-$P(D,".")

 .Q:$D(APCLX($P(D,".")))

 .S APCLX($P(D,"."))=G_"^BH: IPV SCREENING^"_$$VAL^XBDIQ1(9002011,V,1401)_"^^9002011^"_V

 I $O(APCLX(0)) S G=$O(APCLX(0)) Q $S(APCLFORM="D":$P(APCLX(G),U,1),1:APCLX(G))

 Q ""

 ;

LASTCOLO(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - return last Colonoscopy

 ;   - V Procedure: 45.43, 45.22, 45.23, 45.25

 ;   - V CPT : BGP COLO CPTS taxonomy

 ;

 ;  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,E,%,T

 S APCLVAL="",APCLLAST=""

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

 D E

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

 D E

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

 Q APCLLAST

 ;

LASTFSIG(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - return last sigmoidoscopy

 ;   - V Procedure: 45.24, 45.42

 ;   - V CPT : BGP SIG CPTS taxonomy

 ;

 ;  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,E,%,T

 S APCLVAL="",APCLLAST=""

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

 D E

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

 D E

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

 Q APCLLAST

 ;

REMDEPS(P,APCLBD,APCLED) ;PEP - called from reminders to get data on last depression screening exam

 ;  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

 ;

 ;  Output:

 ;returns the string:

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

 ; piece 1:  1 if item found, 0 if no depression screening found in the date range

 ;       2:  date of last depression screening

 ;       3:  text of item found

 ;       4:  value - result

 ;       5:  visit ien on which item found

 ;       6:  file item found in (usually a V File #)

 ;       7:  ien of V File entry found

 ;       

 I '$G(P) Q 0

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

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

 NEW APCLR

 S APCLR=$$LASTDEPS(P,APCLBD,APCLED,"A")

 I APCLR]"" Q 1_"^"_APCLR

 Q 0

APCLAPI   ; IHS/CMI/LAB - visit data ; 25 Feb 2011  11:02 AM

 +1       ;;2.0;IHS PCC SUITE;**6,8,11,14,16**;MAY 14, 2009;Build 9

 +2       ;

LASTALC(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last alcohol screen

 +1       ;  Return the last recorded alcohol screening value:

 +2       ;   - V Exam 35 or Behavioral Health Module Alcohol Screening

 +3       ;   - V measurement AUDC, AUDT, CRFT

 +4       ;   - Health Factor with Alcohol/Drug Category (CAGE)

 +5       ;   - Diagnosis - V POV V79.1

 +6       ;   - Education Topics - V EDUCATION or Behavioral Health Module

 +7       ;     AOD-SCR

 +8       ;     CD-SCR

 +9       ;   - Behavioral Health Module Diagnosis (POV) of 29.1

 +10      ;   - cpts in BGP ALCOHOL SCREENING CPTS taxonomy

 +11      ;   - V POV snomed PXRM BQI ALCOHOL SCREENING

 +12      ;     

 +13      ;  Input:

 +14      ;   APCLPDFN - Patient DFN

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

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

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

 +18      ;                                 A - return value:

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

 +20      ;             Default if blank is D

 +21      ;  Output:

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

 +23      ;   If APCLFORM is A returns the string:

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

 +25      ;         

 +26       IF $GET(APCLPDFN)=""

               QUIT ""

 +27       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +28       IF $GET(APCLED)=""

               SET APCLED=DT

 +29       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +30       NEW APCLLAST,APCLVAL,APCLX

 +31       SET APCLLAST=""

 +32       SET APCLVAL=$$LASTALCS(APCLPDFN,APCLBD,APCLED,"A")

 +33       DO E

 +34       SET APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"ALCOHOL/DRUG",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +35       DO E

 +36       SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP SCREEN FOR ALCOHOLISM DX","A")

 +37       DO E

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

 +39       DO E

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

 +41       DO E

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

 +43       DO E

 +44       SET APCLX=0

           FOR 

               SET APCLX=$ORDER(^AUTTEDT("C","AOD-SCR",APCLX))

               IF APCLX'=+APCLX

                   QUIT 

               Begin DoDot:1

 +45               SET APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"`"_APCLX,"EDUCATION",$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"A")

 +46               DO E

               End DoDot:1

 +47       SET APCLX=0

           FOR 

               SET APCLX=$ORDER(^AUTTEDT("C","CD-SCR",APCLX))

               IF APCLX'=+APCLX

                   QUIT 

               Begin DoDot:1

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

 +49               DO E

               End DoDot:1

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

 +51       DO E

 +52       SET APCLVAL=$$SNOMEDPV^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"PXRM BQI ALCOHOL SCREENING","A")

 +53       DO E

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

 +55       DO E

 +56       SET APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"AOD-SCR","A")

 +57       DO E

 +58       SET APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"CD-SCR","A")

 +59       DO E

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

 +61       DO E

 +62       SET APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"AUDT","A")

 +63       DO E

 +64       SET APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"CRFT","A")

 +65       DO E

 +66       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +67       QUIT APCLLAST

 +68      ;

VE(Y,F,T) ;EP

 +1        QUIT $PIECE(Y,U,1)_"^Exam: "_$PIECE(Y,U,3)_"^"_$$VAL^XBDIQ1(9000010.13,+$PIECE(Y,U,4),.04)_"^"_$PIECE(Y,U,5)_"^9000010.13^"_+$PIECE(Y,U,4)

 +2       ;

LASTALCS(P,BD,ED,F) ;

 +1       ;look for last exam in v exam or bh between bd and ed

 +2        NEW %,E,D,V,X,G

 +3        NEW APCLG,APCLX,APCLC,APCLV

 +4        SET %=P_"^LAST EXAM 35;DURING "_BD_"-"_ED

           SET E=$$START1^APCLDF(%,"APCLG(")

 +5        IF $DATA(APCLG(1))

               SET APCLX(9999999-$PIECE(APCLG(1),U))=$$VE(APCLG(1))

 +6       ;AMHREC field

 +7        SET APCLC=0

           SET APCLV=""

 +8        SET E=(9999999-BD)

           SET D=9999999-ED-1_".99"

           FOR 

               SET D=$ORDER(^AMHREC("AE",P,D))

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

                   QUIT 

               SET V=0

               FOR 

                   SET V=$ORDER(^AMHREC("AE",P,D,V))

                   IF V'=+V!(APCLC)

                       QUIT 

                   Begin DoDot:1

 +9                    SET X=$PIECE($GET(^AMHREC(V,14)),U,3)

 +10      ;no test

                       IF X=""

                           QUIT 

 +11      ;don't count refusal here

                       IF $EXTRACT(X)="U"

                           QUIT 

 +12                   IF X="REF"

                           QUIT 

 +13                   SET G=9999999-$PIECE(D,".")

 +14                   IF $DATA(APCLX($PIECE(D,".")))

                           QUIT 

 +15                   SET APCLX($PIECE(D,"."))=G_"^BH: ALCOHOL SCREENING^"_$$VAL^XBDIQ1(9002011,V,1403)_"^^9002011^"_V

                   End DoDot:1

 +16       IF $ORDER(APCLX(0))

               SET G=$ORDER(APCLX(0))

               QUIT $SELECT(F="D":$PIECE(APCLX(G),U,1),1:APCLX(G))

 +17       QUIT ""

 +18      ;

E         ;

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

               SET APCLLAST=APCLVAL

 +2        QUIT 

 +3       ;

LASTDEPS(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - return last depression screen

 +1       ;  Return the last recorded depression screening value:

 +2       ;   - V Exam 36 or Behavioral Health Module Depression Screening

 +3       ;   - Diagnosis - V POV V79.0

 +4       ;   - Education Topics - V EDUCATION or Behavioral Health Module

 +5       ;     DEP-SCR

 +6       ;   - V Measurement PHQ2, PHQ9, PHQT

 +7       ;   - Behavioral Health Module Diagnosis (POV) of 14.1

 +8       ;   - Diagnosis in BGP MOOD DISORDERS taxonomy in V POV

 +9       ;   - Diagnosis in BGP MOOD DISORDERS taxonomy in BH

 +10      ;   - Problem Code of 14 or 15 in BH

 +11      ;   - V POV snomed PXRM BQI DEPRESSION SCREENING

 +12      ;     

 +13      ;  Input:

 +14      ;   APCLPDFN - Patient DFN

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

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

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

 +18      ;                                 A - return value:

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

 +20      ;             Default if blank is D

 +21      ;  Output:

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

 +23      ;   If APCLFORM is A returns the string:

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

 +25      ;         

 +26       IF $GET(APCLBD)=""

               SET APCLBD=$$DOB^AUPNPAT(APCLPDFN)

 +27       IF $GET(APCLED)=""

               SET APCLED=DT

 +28       IF $GET(APCLFORM)=""

               SET APCLFORM="D"

 +29       NEW APCLLAST,APCLVAL,APCLX

 +30       SET APCLLAST=""

 +31       SET APCLVAL=$$LASTDEP(APCLPDFN,APCLBD,APCLED,"A")

 +32       DO E

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

 +34       DO E

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

 +36       DO E

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

 +38       DO E

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

 +40       DO E

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

 +42       DO E

 +43       SET APCLX=0

           FOR 

               SET APCLX=$ORDER(^AUTTEDT("C","DEP-SCR",APCLX))

               IF APCLX'=+APCLX

                   QUIT 

               Begin DoDot:1

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

 +45               DO E

               End DoDot:1

 +46       SET APCLVAL=$$SNOMEDPV^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"PXRM BQI DEPRESSION SCREENING","A")

 +47       DO E

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

 +49       DO E

 +50       SET APCLVAL=$$LASTBHED^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"DEP-SCR","A")

 +51       DO E

 +52      ;now check for mood disorders

 +53       SET APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP MOOD DISORDERS","A")

 +54       DO E

 +55       SET APCLVAL=$$LASTBHDT^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"BGP MOOD DISORDERS","A")

 +56       DO E

 +57       SET APCLVAL=$$LASTBHDX^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"14","A")

 +58       DO E

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

 +60       DO E

 +61       SET APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"PHQ2","A")

 +62       DO E

 +63       SET APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"PHQ9","A")

 +64       DO E

 +65       SET APCLVAL=$$LASTBHME^APCLAPIU(APCLPDFN,$SELECT($PIECE(APCLLAST,U)]"":$PIECE(APCLLAST,U),1:APCLBD),APCLED,"PHQT","A")

 +66       DO E

 +67       IF APCLFORM="D"

               QUIT $PIECE(APCLLAST,U)

 +68       QUIT APCLLAST

 +69      ;

LASTDEP(P,BD,ED,F) ;

 +1        NEW %,E,D,V,X,G

 +2        NEW APCLG,APCLX,APCLC,APCLV

 +3        SET %=P_"^LAST EXAM 36;DURING "_BD_"-"_ED

           SET E=$$START1^APCLDF(%,"APCLG(")

 +4        IF $DATA(APCLG(1))

               SET APCLX(9999999-$PIECE(APCLG(1),U))=$$VE(APCLG(1))

 +5       ;now look at AMHREC

 +6        SET APCLC=0

           SET APCLV=""

 +7        SET E=(9999999-BD)

           SET D=9999999-ED-1_".99"

           FOR 

               SET D=$ORDER(^AMHREC("AE",P,D))

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

                   QUIT 

               SET V=0

               FOR 

                   SET V=$ORDER(^AMHREC("AE",P,D,V))

                   IF V'=+V!(APCLC)

                       QUIT