Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCLAPI1

APCLAPI1.m

Go to the documentation of this file. 
  1. 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
  1.  ;IHS/TUCSON/LAB - added G parameter to provider call
  1.  ;
  1.  ;
  1.  ;BJPC v1.0 patch 1
  1.  ;
  1. LASTMAM(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last MAMMOGRAM
  1.  ;  Return the last recorded MAMMOGRAM:
  1.  ;   - V Radiology with CPT in BGP CPT MAMMOGRAM taxonomy
  1.  ;   - Diagnosis - V POV V76.11, V76.12
  1.  ;   - Procedures: 87.36, 87.37
  1.  ;   - V CPT:  BGP CPT MAMMOGRAM taxonomy
  1.  ;   - Women's Health Procedures: MAMMOGRAM SCREENING, MAMMOGRAM DX UNILAT, MAMMOGRAM DX BILAT
  1.  ;     
  1.  ;  Input:
  1.  ;   APCLPDFN - Patient DFN
  1.  ;   APCLBD - beginning date to begin search for value - if blank, default is DOB
  1.  ;   APCLED - ending date of search - if blank, default is DT
  1.  ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801
  1.  ;                                 A - return value:
  1.  ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
  1.  ;             Default if blank is D
  1.  ;  Output:
  1.  ;   If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
  1.  ;   If APCLFORM is A returns the string:
  1.  ;     date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
  1.  ; 
  1.  I $G(APCLPDFN)="" Q ""
  1.  I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
  1.  I $G(APCLED)="" S APCLED=DT
  1.  I $G(APCLFORM)="" S APCLFORM="D"
  1.  NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E
  1.  S APCLLAST=""
  1.  S APCLVAL=$$LASTRADT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT MAMMOGRAM","A")
  1.  D E
  1.  S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP MAMMOGRAM DXS","A")
  1.  D E
  1.  ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"V76.12","DX",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  ;D E
  1.  S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP MAMMOGRAM PROCEDURES","A")
  1.  D E
  1.  ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"87.37","PROCEDURE",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  ;D E
  1.  S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT MAMMOGRAM","A")
  1.  D E
  1.  ;if wh v3.0 get date for last mammogram
  1.  ;I $$VERSION^XPDUTL("BW")>2.9 F X="MAMMOGRAM SCREENING","MAMMOGRAM DX UNILATERAL","MAMMOGRAM DX BILATERAL","MAMMOGRAM, UNSPECIFIED" D
  1.  ;.S T=$O(^BWVPDT("B",X,0))
  1.  ;.S V=$$WHAPI^BWVPAT1(APCLPDFN,T)
  1.  ;.I $P(V,U)=0 S $P(V,U)=""
  1.  ;.Q:$P(APCLLAST,U)>$P(V,U)
  1.  ;.S APCLLAST=$P(V,U)_"^WH: "_X_"^^^90515^"
  1.  ;now check wh package directly
  1.  F X="MAMMOGRAM SCREENING","MAMMOGRAM DX UNILAT","MAMMOGRAM DX BILAT" D
  1.  .S T=$O(^BWPN("B",X,0))
  1.  .I T D
  1.  ..S (G,V)=0 F  S V=$O(^BWPCD("C",APCLPDFN,V)) Q:V=""!(G)  D
  1.  ...Q:'$D(^BWPCD(V,0))
  1.  ...I $P(^BWPCD(V,0),U,4)'=T Q
  1.  ...S D=$P(^BWPCD(V,0),U,12)
  1.  ...Q:$P(APCLLAST,U)>D
  1.  ...Q:D>APCLED
  1.  ...Q:$$VAL^XBDIQ1(9002086.1,V,.05)="Error/disregard"
  1.  ...S APCLLAST=D_"^WH: "_X_"^^^9002086.1^"_V
  1.  .Q
  1.  I APCLFORM="D" Q $P(APCLLAST,U)
  1.  Q APCLLAST
  1.  ;
  1. VR ;EP
  1.  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
  1.  Q
  1.  ;
  1. E ;
  1.  I $P(APCLVAL,U,1)>$P(APCLLAST,U,1) S APCLLAST=APCLVAL
  1.  Q
  1.  ;
  1. LASTPAP(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last PAP SMEAR
  1.  ;  Return the last recorded PAP SMEAR:
  1.  ;   - V Lab "PAP SMEAR" or in BGP PAP SMEAR TAX taxonomy
  1.  ;   - Diagnosis - in BGP PAP SMEAR DXS taxonomy
  1.  ;   - Procedures: 91.46
  1.  ;   - V CPT:  BGP CPT PAP taxonomy
  1.  ;   - Women's Health Procedures: PAP SMEAR
  1.  ;     
  1.  ;  Input:
  1.  ;   APCLPDFN - Patient DFN
  1.  ;   APCLBD - beginning date to begin search for value - if blank, default is DOB
  1.  ;   APCLED - ending date of search - if blank, default is DT
  1.  ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801
  1.  ;                                 A - return value:
  1.  ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
  1.  ;             Default if blank is D
  1.  ;  Output:
  1.  ;   If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
  1.  ;   If APCLFORM is A returns the string:
  1.  ;     date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
  1.  ; 
  1.  I $G(APCLPDFN)="" Q ""
  1.  I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
  1.  I $G(APCLED)="" S APCLED=DT
  1.  I $G(APCLFORM)="" S APCLFORM="D"
  1.  NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E
  1.  S APCLLAST=""
  1.  S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"[BGP PAP SMEAR TAX","LAB",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  D E
  1.  S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"PAP SMEAR","LAB",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  D E
  1.  ;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
  1.  ;D E
  1.  S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP PAP PROCEDURES","A")
  1.  D E
  1.  S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP CPT PAP","A")
  1.  D E
  1.  ;if wh v3.0 get date for last mammogram
  1.  ;I $$VERSION^XPDUTL("BW")>2 F X="PAP SMEAR" D
  1.  ;.S T=$O(^BWVPDT("B",X,0))
  1.  ;.S V=$$WHAPI^BWVPAT1(APCLPDFN,T)
  1.  ;.I $P(V,U)=0 S $P(V,U)=""
  1.  ;.Q:$P(APCLLAST,U)>$P(V,U)
  1.  ;.S APCLLAST=$P(V,U)_"^WH: "_X_"^^^90515^"
  1.  ;now check wh package directly
  1.  F X="PAP SMEAR" D
  1.  .S T=$O(^BWPN("B",X,0))
  1.  .I T D
  1.  ..S (G,V)=0 F  S V=$O(^BWPCD("C",APCLPDFN,V)) Q:V=""!(G)  D
  1.  ...Q:'$D(^BWPCD(V,0))
  1.  ...I $P(^BWPCD(V,0),U,4)'=T Q
  1.  ...S D=$P(^BWPCD(V,0),U,12)
  1.  ...Q:$P(APCLLAST,U)>D
  1.  ...Q:D>APCLED
  1.  ...Q:$$VAL^XBDIQ1(9002086.1,V,.05)="Error/disregard"
  1.  ...S APCLLAST=D_"^WH: "_X_"^^^9002086.1^"_V
  1.  .Q
  1.  I APCLFORM="D" Q $P(APCLLAST,U)
  1.  Q APCLLAST
  1.  ;
  1. 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
  1.  ;SMOKING USE API LASTSMOK, IF YOU WANT LAST SMOKELESS USE LASTSMLE IF YOU WANT EXPOSURE USE
  1.  ;LASTSMEX
  1.  ;  Return the last recorded TOBACCO USE SCREENING:
  1.  ;   - V Health Factor in Category TOBACCO (SMOKING), TOBACCO (SMOKELESS - CHEWING/DIP), TOBACCO (EXPOSURE)
  1.  ;   - V CPT 1034F, 1035F, 1036F
  1.  ;   - V POV [BGP GPRA SMOKING DXS]
  1.  ;   - V DENTAL ADA 1320
  1.  ;     
  1.  ;  Input:
  1.  ;   APCLPDFN - Patient DFN
  1.  ;   APCLBD - beginning date to begin search for value - if blank, default is DOB
  1.  ;   APCLED - ending date of search - if blank, default is DT
  1.  ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801
  1.  ;                                 A - return value:
  1.  ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
  1.  ;             Default if blank is D
  1.  ;  Output:
  1.  ;   If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
  1.  ;   If APCLFORM is A returns the string:
  1.  ;     date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
  1.  ; 
  1.  I $G(APCLPDFN)="" Q ""
  1.  I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
  1.  I $G(APCLED)="" S APCLED=DT
  1.  I $G(APCLFORM)="" S APCLFORM="D"
  1.  NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E
  1.  S APCLLAST=""
  1.  S APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (SMOKING)",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  D E
  1.  S APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (SMOKELESS - CHEWING/DIP)",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  D E
  1.  S APCLVAL=$$LASTHF^APCLAPIU(APCLPDFN,"TOBACCO (EXPOSURE)",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  D E
  1.  S R=$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD)
  1.  S APCLVAL=$$LASTCPTT^APCLAPIU(APCLPDFN,R,APCLED,"BGP TOBACCO SCREEN CPTS","A")
  1.  D E
  1.  S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"1320","ADA",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  D E
  1.  S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP TOBACCO DXS","A")
  1.  D E
  1.  I APCLFORM="D" Q $P(APCLLAST,U)
  1.  Q APCLLAST
  1.  ;
  1. LASTTON(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last TONOMETRY
  1.  ;  Return the last recorded TONOMETRY:
  1.  ;   - V Exam - 26 TONOMETRY
  1.  ;   - V Measurement - TON
  1.  ;   - Procedures: 89.11, 95.26
  1.  ;   - V CPT:  S0620, S0621, 92100, 92120, 92499
  1.  ;     
  1.  ;  Input:
  1.  ;   APCLPDFN - Patient DFN
  1.  ;   APCLBD - beginning date to begin search for value - if blank, default is DOB
  1.  ;   APCLED - ending date of search - if blank, default is DT
  1.  ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801
  1.  ;                                 A - return value:
  1.  ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
  1.  ;             Default if blank is D
  1.  ;  Output:
  1.  ;   If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
  1.  ;   If APCLFORM is A returns the string:
  1.  ;     date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
  1.  ; 
  1.  I $G(APCLPDFN)="" Q ""
  1.  I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
  1.  I $G(APCLED)="" S APCLED=DT
  1.  I $G(APCLFORM)="" S APCLFORM="D"
  1.  NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E
  1.  S APCLLAST=""
  1.  S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,26,"EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  D E
  1.  S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"TON","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  D E
  1.  S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH TONOMETRY PROCS","A")
  1.  D E
  1.  S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"S0620;S0621;92100;92120;92499","A")
  1.  D E
  1.  I APCLFORM="D" Q $P(APCLLAST,U)
  1.  Q APCLLAST
  1.  ;
  1. LASTVAE(APCLPDFN,APCLBD,APCLED,APCLFORM) ;PEP - date of last VISUAL ACUITY EXAM
  1.  ;  Return the last recorded VISUAL ACUITY EXAM:
  1.  ;   - V Exam - 19 VISION EXAM
  1.  ;   - V Measurement - VU - VISION UNCORRECTED or VC - VISION CORRECTED
  1.  ;   - Procedures: 95.09, 95.05
  1.  ;   - V CPT:  99172, 99173
  1.  ;   - V POV: V72.0
  1.  ;     
  1.  ;  Input:
  1.  ;   APCLPDFN - Patient DFN
  1.  ;   APCLBD - beginning date to begin search for value - if blank, default is DOB
  1.  ;   APCLED - ending date of search - if blank, default is DT
  1.  ;   APCLFORM -  APCLFORM returned:  D - return date only - example 3070801
  1.  ;                                 A - return value:
  1.  ;                       date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
  1.  ;             Default if blank is D
  1.  ;  Output:
  1.  ;   If APCLFORM is blank or APCLFORM is D returns internal fileman date if one found otherwise returns null
  1.  ;   If APCLFORM is A returns the string:
  1.  ;     date^text of item found^value if appropriate^visit ien^File found in^ien of file found in
  1.  ; 
  1.  I $G(APCLPDFN)="" Q ""
  1.  I $G(APCLBD)="" S APCLBD=$$DOB^AUPNPAT(APCLPDFN)
  1.  I $G(APCLED)="" S APCLED=DT
  1.  I $G(APCLFORM)="" S APCLFORM="D"
  1.  NEW APCLLAST,APCLVAL,APCLX,R,X,Y,V,E
  1.  S APCLLAST=""
  1.  S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,26,"EXAM",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  D E
  1.  S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"07","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  D E
  1.  S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"08","MEASUREMENT",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  D E
  1.  S APCLVAL=$$LASTDXT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"BGP EYE EXAM DXS","A")
  1.  D E
  1.  S APCLVAL=$$LASTPRCT^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"APCH VISION EXAM PROCS","A")
  1.  D E
  1.  ;S APCLVAL=$$LASTITEM^APCLAPIU(APCLPDFN,"95.09","PROCEDURE",$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"A")
  1.  ;D E
  1.  S APCLVAL=$$LASTCPTI^APCLAPIU(APCLPDFN,$S($P(APCLLAST,U)]"":$P(APCLLAST,U),1:APCLBD),APCLED,"99172;99173","A")
  1.  D E
  1.  I APCLFORM="D" Q $P(APCLLAST,U)
  1.  Q APCLLAST