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

BUD8RPTD.m

Go to the documentation of this file. 
  1. BUD8RPTD ; 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,BUDMEDV=0,BUDMEDVI=""
  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(^BUDGSITE(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(^BUDGCNTL("B","FIRST LEVEL CLINIC EXCLUSIONS",0))
  1.  .I C]"",$D(^BUDGCNTL(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(^BUDGCNTL("B","CLINIC EXCLUSIONS",0))
  1.  .S C=$$CLINIC^APCLV(V,"C")
  1.  .I C]"",$D(^BUDGCNTL(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 CHECK FOR MEDICAL CARE
  1.  .S BUDTIEN=$O(^BUDGCNTL("B","MEDICAL CARE PROVIDERS",0))
  1.  .S Y=$$PRIMPROV^APCLV(V,"D") I $D(^BUDGCNTL(BUDTIEN,11,"B",Y)) S BUDMEDV=BUDMEDV+1,BUDMEDVI=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(^BUDGCNTL("B","CLINIC EXCLUSIONS",0))
  1.  .S C=$$CLINIC^APCLV(V,"C")
  1.  .I C]"",$D(^BUDGCNTL(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(^BUDGSITE(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(^BUDGSITE(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