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

BUD7RPTD.m

Go to the documentation of this file.
  1. BUD7RPTD ; IHS/CMI/LAB - UDS REPORT PROCESSOR ;
  1. ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
  1. ;
  1. ;
  1. GETV ;EP - get all visits for this patient and tally in BUDTV
  1. ;^TMP($J,"VISITSLIST") has all visits, including orphans that will be needed for either table
  1. ;3, 5 or 6 dx or 6 services
  1. ;^TMP($J,"VISITS35") has all visits to count for tables 3,5 which excludes 2 visits to the same provider
  1. ;on the same day
  1. ;^TMP($J,"VISITSLIST") is used for table 6 services only
  1. ;^TMP($J,"VISITS35") is used for table 3 and 5
  1. ;^TMP($J,"VISITS6DX") is used for table 6 dxs and includes 2 visits on same day to same provider
  1. K ^TMP($J)
  1. S BUDTV=0,BUDT35V=0,BUDT6V=0
  1. S A="^TMP($J,""VISITS"",",B=DFN_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BUDBD)_"-"_$$FMTE^XLFDT(BUDED),E=$$START1^APCLDF(B,A)
  1. I '$D(^TMP($J,"VISITS",1)) Q
  1. S X=0 F S X=$O(^TMP($J,"VISITS",X)) Q:X'=+X S V=$P(^TMP($J,"VISITS",X),U,5) D
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .Q:'$P(^AUPNVSIT(V,0),U,9)
  1. .Q:$P(^AUPNVSIT(V,0),U,11)
  1. .S L=$P(^AUPNVSIT(V,0),U,6)
  1. .Q:L=""
  1. .Q:'$D(^BUDESITE(BUDSITE,11,L)) ;not valid location
  1. .Q:$P(^AUPNVSIT(V,0),U,7)="C"
  1. .Q:$P(^AUPNVSIT(V,0),U,7)="T"
  1. .Q:$P(^AUPNVSIT(V,0),U,7)="N"
  1. .Q:$P(^AUPNVSIT(V,0),U,7)="D"
  1. .Q:$P(^AUPNVSIT(V,0),U,7)="X"
  1. .S C=$$CLINIC^APCLV(V,"C")
  1. .S BUDTIEN=$O(^BUDECNTL("B","FIRST LEVEL CLINIC EXCLUSIONS",0))
  1. .I C]"",$D(^BUDECNTL(BUDTIEN,11,"B",C)) Q ;not a clinic code we want in any table
  1. .S BUDTV=BUDTV+1
  1. .S ^TMP($J,"VISITSLIST",V)=""
  1. ;now set up ^TMP($J,"VISITS35") must have at least 1 of these to be in the report at all
  1. ;loop through all visits and eliminate all from clinics, and eliminate orphans
  1. S V=0 F S V=$O(^TMP($J,"VISITSLIST",V)) Q:V'=+V D
  1. .I '$D(^AUPNVPRV("AD",V)) Q
  1. .I $$PRIMPROV^APCLV(V,"D")="" Q ;no prim prov disc
  1. .I '$D(^AUPNVPOV("AD",V)) Q
  1. .;must have a primary dx other than .9999
  1. .S Y=$$PRIMPOV^APCLV(V,"C") I Y=".9999" Q
  1. .;the above make it a "complete" visit
  1. .S BUDTIEN=$O(^BUDECNTL("B","CLINIC EXCLUSIONS",0))
  1. .S C=$$CLINIC^APCLV(V,"C")
  1. .I C]"",$D(^BUDECNTL(BUDTIEN,11,"B",C)) Q ;exclude these clinics
  1. .Q:"AHSORI"'[$P(^AUPNVSIT(V,0),U,7) ;new in 07 to exclude these from tables 3,5
  1. .I $D(^TMP($J,"SAMEPROV",$$PRIMPROV^APCLV(V,"I"),$P($P(^AUPNVSIT(V,0),U),"."))) Q ;already got one on this day, this provider
  1. .S ^TMP($J,"SAMEPROV",$$PRIMPROV^APCLV(V,"I"),$P($P(^AUPNVSIT(V,0),U),"."))=V
  1. .S BUDT35V=BUDT35V+1
  1. .S ^TMP($J,"VISITS35",V)=""
  1. ;NOW get all for table 6 dxs, same list but include duplicates
  1. S V=0 F S V=$O(^TMP($J,"VISITSLIST",V)) Q:V'=+V D
  1. .I '$D(^AUPNVPRV("AD",V)) Q
  1. .I $$PRIMPROV^APCLV(V,"D")="" Q ;no prim prov disc
  1. .I '$D(^AUPNVPOV("AD",V)) Q
  1. .;must have a primary dx other than .9999
  1. .S Y=$$PRIMPOV^APCLV(V,"C") I Y=".9999" Q
  1. .S BUDTIEN=$O(^BUDECNTL("B","CLINIC EXCLUSIONS",0))
  1. .S C=$$CLINIC^APCLV(V,"C")
  1. .I C]"",$D(^BUDECNTL(BUDTIEN,11,"B",C)) Q ;exclude these clinics
  1. .Q:$P(^AUPNVSIT(V,0),U,7)="E"
  1. .S BUDT6V=BUDT6V+1
  1. .S ^TMP($J,"VISITS6DX",V)=""
  1. .Q
  1. ;now get all mamms and paps in date range and count as orphans if at this facility and no mam on that date in pcc
  1. Q:BUDT35V=0 ;not a patient of interest
  1. ;Q:'$D(^BWP(DFN))
  1. S T="MAMMOGRAM SCREENING",T=$O(^BWPN("B",T,0))
  1. S T1="MAMMOGRAM DX BILAT",T1=$O(^BWPN("B",T1,0))
  1. S T2="MAMMOGRAM DX UNILAT",T2=$O(^BWPN("B",T2,0))
  1. I $$VERSION^XPDUTL("BW")<3 D
  1. .S (G,V)=0 F S V=$O(^BWPCD("C",DFN,V)) Q:V="" D
  1. ..Q:'$D(^BWPCD(V,0))
  1. ..S D=$P(^BWPCD(V,0),U,12)
  1. ..S J=$P(^BWPCD(V,0),U,4) I J=T!(J=T1)!(J=T2) D Q
  1. ...Q:D<BUDBD
  1. ...Q:D>BUDED
  1. ...Q:$P($G(^BWPCD(V,"PCC")),U,1)]"" ;already in pcc
  1. ...S L=$P(^BWPCD(V,0),U,10)
  1. ...Q:L=""
  1. ...Q:'$D(^BUDESITE(BUDSITE,11,L)) ;not valid location
  1. ...S ^TMP($J,"MAMMS",V)="WH "_$$VAL^XBDIQ1(9002086.1,V,.04)_U_$$FMTE^XLFDT(D)
  1. .Q
  1. ;;E D
  1. ;.S T="MAMMOGRAM SCREENING",T=$O(^BWVPDT("B",T,0))
  1. ;.S T1="MAMMOGRAM DX BILAT",T1=$O(^BWVPDT("B",T1,0))
  1. ;.S T2="MAMMOGRAM DX UNILAT",T2=$O(^BWVPDT("B",T2,0))
  1. ;.S D=$$FINDLSTD^BWVPRD(DFN,T_"^"_T1_"^"_T2,BUDBD,BUDED)
  1. ;.Q:D=0
  1. ;.Q:D=""
  1. ;.;check location here
  1. ;.S ^TMP($J,"MAMMS",1)="WH MAMMOGRAM "_U_$$FMTE^XLFDT(D)_U_D
  1. S T="PAP SMEAR",T=$O(^BWPN("B",T,0))
  1. I $$VERSION^XPDUTL("BW")<3 D
  1. .S (G,V)=0 F S V=$O(^BWPCD("C",DFN,V)) Q:V="" D
  1. ..Q:'$D(^BWPCD(V,0))
  1. ..S D=$P(^BWPCD(V,0),U,12)
  1. ..S J=$P(^BWPCD(V,0),U,4) I J=T D Q
  1. ...Q:D<BUDBD
  1. ...Q:D>BUDED
  1. ...Q:$P($G(^BWPCD(V,"PCC")),U,1)]"" ;already in pcc
  1. ...S L=$P(^BWPCD(V,0),U,10)
  1. ...Q:L=""
  1. ...Q:'$D(^BUDESITE(BUDSITE,11,L)) ;not valid location
  1. ...S ^TMP($J,"PAPS",V)="WH PAP SMEAR"_U_$$FMTE^XLFDT(D)
  1. .Q
  1. ;E D
  1. ;.S T="PAP SMEAR",T=$O(^BWVPDT("B",T,0))
  1. ;.S D=$$FINDLSTD^BWVPRD(DFN,T,BUDBD,BUDED)
  1. ;.Q:D=0
  1. ;.Q:D=""
  1. ;.;check location here
  1. ;.S ^TMP($J,"PAPS",1)="WH PAP SMEAR "_U_$$FMTE^XLFDT(D)_U_D
  1. ;.S ^DIBT(4370,1,DFN)=""
  1. ;.Q
  1. Q