BUD8RPTD ; IHS/CMI/LAB - UDS REPORT PROCESSOR ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
GETV ;EP - get all visits for this patient and tally in BUDTV
;^TMP($J,"VISITSLIST") has all visits, including orphans that will be needed for either table
;3, 5 or 6 dx or 6 services
;^TMP($J,"VISITS35") has all visits to count for tables 3,5 which excludes 2 visits to the same provider
;on the same day
;^TMP($J,"VISITSLIST") is used for table 6 services only
;^TMP($J,"VISITS35") is used for table 3 and 5
;^TMP($J,"VISITS6DX") is used for table 6 dxs and includes 2 visits on same day to same provider
K ^TMP($J)
S BUDTV=0,BUDT35V=0,BUDT6V=0,BUDMEDV=0,BUDMEDVI=""
S A="^TMP($J,""VISITS"",",B=DFN_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BUDBD)_"-"_$$FMTE^XLFDT(BUDED),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"VISITS",1)) Q
S X=0 F S X=$O(^TMP($J,"VISITS",X)) Q:X'=+X S V=$P(^TMP($J,"VISITS",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.S L=$P(^AUPNVSIT(V,0),U,6)
.Q:L=""
.Q:'$D(^BUDGSITE(BUDSITE,11,L)) ;not valid location
.Q:$P(^AUPNVSIT(V,0),U,7)="C"
.Q:$P(^AUPNVSIT(V,0),U,7)="T"
.Q:$P(^AUPNVSIT(V,0),U,7)="N"
.Q:$P(^AUPNVSIT(V,0),U,7)="D"
.Q:$P(^AUPNVSIT(V,0),U,7)="X"
.S C=$$CLINIC^APCLV(V,"C")
.S BUDTIEN=$O(^BUDGCNTL("B","FIRST LEVEL CLINIC EXCLUSIONS",0))
.I C]"",$D(^BUDGCNTL(BUDTIEN,11,"B",C)) Q ;not a clinic code we want in any table
.S BUDTV=BUDTV+1
.S ^TMP($J,"VISITSLIST",V)=""
;now set up ^TMP($J,"VISITS35") must have at least 1 of these to be in the report at all
;loop through all visits and eliminate all from clinics, and eliminate orphans
S V=0 F S V=$O(^TMP($J,"VISITSLIST",V)) Q:V'=+V D
.I '$D(^AUPNVPRV("AD",V)) Q
.I $$PRIMPROV^APCLV(V,"D")="" Q ;no prim prov disc
.I '$D(^AUPNVPOV("AD",V)) Q
.;must have a primary dx other than .9999
.S Y=$$PRIMPOV^APCLV(V,"C") I Y=".9999" Q
.;the above make it a "complete" visit
.S BUDTIEN=$O(^BUDGCNTL("B","CLINIC EXCLUSIONS",0))
.S C=$$CLINIC^APCLV(V,"C")
.I C]"",$D(^BUDGCNTL(BUDTIEN,11,"B",C)) Q ;exclude these clinics
.Q:"AHSORI"'[$P(^AUPNVSIT(V,0),U,7) ;new in 07 to exclude these from tables 3,5
.I $D(^TMP($J,"SAMEPROV",$$PRIMPROV^APCLV(V,"I"),$P($P(^AUPNVSIT(V,0),U),"."))) Q ;already got one on this day, this provider
.S ^TMP($J,"SAMEPROV",$$PRIMPROV^APCLV(V,"I"),$P($P(^AUPNVSIT(V,0),U),"."))=V
.S BUDT35V=BUDT35V+1
.S ^TMP($J,"VISITS35",V)=""
.;NOW CHECK FOR MEDICAL CARE
.S BUDTIEN=$O(^BUDGCNTL("B","MEDICAL CARE PROVIDERS",0))
.S Y=$$PRIMPROV^APCLV(V,"D") I $D(^BUDGCNTL(BUDTIEN,11,"B",Y)) S BUDMEDV=BUDMEDV+1,BUDMEDVI=V
;NOW get all for table 6 dxs, same list but include duplicates
S V=0 F S V=$O(^TMP($J,"VISITSLIST",V)) Q:V'=+V D
.I '$D(^AUPNVPRV("AD",V)) Q
.I $$PRIMPROV^APCLV(V,"D")="" Q ;no prim prov disc
.I '$D(^AUPNVPOV("AD",V)) Q
.;must have a primary dx other than .9999
.S Y=$$PRIMPOV^APCLV(V,"C") I Y=".9999" Q
.S BUDTIEN=$O(^BUDGCNTL("B","CLINIC EXCLUSIONS",0))
.S C=$$CLINIC^APCLV(V,"C")
.I C]"",$D(^BUDGCNTL(BUDTIEN,11,"B",C)) Q ;exclude these clinics
.Q:$P(^AUPNVSIT(V,0),U,7)="E"
.S BUDT6V=BUDT6V+1
.S ^TMP($J,"VISITS6DX",V)=""
.Q
;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
Q:BUDT35V=0 ;not a patient of interest
;Q:'$D(^BWP(DFN))
S T="MAMMOGRAM SCREENING",T=$O(^BWPN("B",T,0))
S T1="MAMMOGRAM DX BILAT",T1=$O(^BWPN("B",T1,0))
S T2="MAMMOGRAM DX UNILAT",T2=$O(^BWPN("B",T2,0))
I $$VERSION^XPDUTL("BW")<3 D
.S (G,V)=0 F S V=$O(^BWPCD("C",DFN,V)) Q:V="" D
..Q:'$D(^BWPCD(V,0))
..S D=$P(^BWPCD(V,0),U,12)
..S J=$P(^BWPCD(V,0),U,4) I J=T!(J=T1)!(J=T2) D Q
...Q:D<BUDBD
...Q:D>BUDED
...Q:$P($G(^BWPCD(V,"PCC")),U,1)]"" ;already in pcc
...S L=$P(^BWPCD(V,0),U,10)
...Q:L=""
...Q:'$D(^BUDGSITE(BUDSITE,11,L)) ;not valid location
...S ^TMP($J,"MAMMS",V)="WH "_$$VAL^XBDIQ1(9002086.1,V,.04)_U_$$FMTE^XLFDT(D)
.Q
;;E D
;.S T="MAMMOGRAM SCREENING",T=$O(^BWVPDT("B",T,0))
;.S T1="MAMMOGRAM DX BILAT",T1=$O(^BWVPDT("B",T1,0))
;.S T2="MAMMOGRAM DX UNILAT",T2=$O(^BWVPDT("B",T2,0))
;.S D=$$FINDLSTD^BWVPRD(DFN,T_"^"_T1_"^"_T2,BUDBD,BUDED)
;.Q:D=0
;.Q:D=""
;.;check location here
;.S ^TMP($J,"MAMMS",1)="WH MAMMOGRAM "_U_$$FMTE^XLFDT(D)_U_D
S T="PAP SMEAR",T=$O(^BWPN("B",T,0))
I $$VERSION^XPDUTL("BW")<3 D
.S (G,V)=0 F S V=$O(^BWPCD("C",DFN,V)) Q:V="" D
..Q:'$D(^BWPCD(V,0))
..S D=$P(^BWPCD(V,0),U,12)
..S J=$P(^BWPCD(V,0),U,4) I J=T D Q
...Q:D<BUDBD
...Q:D>BUDED
...Q:$P($G(^BWPCD(V,"PCC")),U,1)]"" ;already in pcc
...S L=$P(^BWPCD(V,0),U,10)
...Q:L=""
...Q:'$D(^BUDGSITE(BUDSITE,11,L)) ;not valid location
...S ^TMP($J,"PAPS",V)="WH PAP SMEAR"_U_$$FMTE^XLFDT(D)
.Q
;E D
;.S T="PAP SMEAR",T=$O(^BWVPDT("B",T,0))
;.S D=$$FINDLSTD^BWVPRD(DFN,T,BUDBD,BUDED)
;.Q:D=0
;.Q:D=""
;.;check location here
;.S ^TMP($J,"PAPS",1)="WH PAP SMEAR "_U_$$FMTE^XLFDT(D)_U_D
;.S ^DIBT(4370,1,DFN)=""
;.Q
Q
BUD8RPTD ; IHS/CMI/LAB - UDS REPORT PROCESSOR ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
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
+2 ;3, 5 or 6 dx or 6 services
+3 ;^TMP($J,"VISITS35") has all visits to count for tables 3,5 which excludes 2 visits to the same provider
+4 ;on the same day
+5 ;^TMP($J,"VISITSLIST") is used for table 6 services only
+6 ;^TMP($J,"VISITS35") is used for table 3 and 5
+7 ;^TMP($J,"VISITS6DX") is used for table 6 dxs and includes 2 visits on same day to same provider
+8 KILL ^TMP($JOB)
+9 SET BUDTV=0
SET BUDT35V=0
SET BUDT6V=0
SET BUDMEDV=0
SET BUDMEDVI=""
+10 SET A="^TMP($J,""VISITS"","
SET B=DFN_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BUDBD)_"-"_$$FMTE^XLFDT(BUDED)
SET E=$$START1^APCLDF(B,A)
+11 IF '$DATA(^TMP($JOB,"VISITS",1))
QUIT
+12 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"VISITS",X))
IF X'=+X
QUIT
SET V=$PIECE(^TMP($JOB,"VISITS",X),U,5)
Begin DoDot:1
+13 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+14 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+15 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+16 SET L=$PIECE(^AUPNVSIT(V,0),U,6)
+17 IF L=""
QUIT
+18 ;not valid location
IF '$DATA(^BUDGSITE(BUDSITE,11,L))
QUIT
+19 IF $PIECE(^AUPNVSIT(V,0),U,7)="C"
QUIT
+20 IF $PIECE(^AUPNVSIT(V,0),U,7)="T"
QUIT
+21 IF $PIECE(^AUPNVSIT(V,0),U,7)="N"
QUIT
+22 IF $PIECE(^AUPNVSIT(V,0),U,7)="D"
QUIT
+23 IF $PIECE(^AUPNVSIT(V,0),U,7)="X"
QUIT
+24 SET C=$$CLINIC^APCLV(V,"C")
+25 SET BUDTIEN=$ORDER(^BUDGCNTL("B","FIRST LEVEL CLINIC EXCLUSIONS",0))
+26 ;not a clinic code we want in any table
IF C]""
IF $DATA(^BUDGCNTL(BUDTIEN,11,"B",C))
QUIT
+27 SET BUDTV=BUDTV+1
+28 SET ^TMP($JOB,"VISITSLIST",V)=""
End DoDot:1
+29 ;now set up ^TMP($J,"VISITS35") must have at least 1 of these to be in the report at all
+30 ;loop through all visits and eliminate all from clinics, and eliminate orphans
+31 SET V=0
FOR
SET V=$ORDER(^TMP($JOB,"VISITSLIST",V))
IF V'=+V
QUIT
Begin DoDot:1
+32 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+33 ;no prim prov disc
IF $$PRIMPROV^APCLV(V,"D")=""
QUIT
+34 IF '$DATA(^AUPNVPOV("AD",V))
QUIT
+35 ;must have a primary dx other than .9999
+36 SET Y=$$PRIMPOV^APCLV(V,"C")
IF Y=".9999"
QUIT
+37 ;the above make it a "complete" visit
+38 SET BUDTIEN=$ORDER(^BUDGCNTL("B","CLINIC EXCLUSIONS",0))
+39 SET C=$$CLINIC^APCLV(V,"C")
+40 ;exclude these clinics
IF C]""
IF $DATA(^BUDGCNTL(BUDTIEN,11,"B",C))
QUIT
+41 ;new in 07 to exclude these from tables 3,5
IF "AHSORI"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+42 ;already got one on this day, this provider
IF $DATA(^TMP($JOB,"SAMEPROV",$$PRIMPROV^APCLV(V,"I"),$PIECE($PIECE(^AUPNVSIT(V,0),U),".")))
QUIT
+43 SET ^TMP($JOB,"SAMEPROV",$$PRIMPROV^APCLV(V,"I"),$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))=V
+44 SET BUDT35V=BUDT35V+1
+45 SET ^TMP($JOB,"VISITS35",V)=""
+46 ;NOW CHECK FOR MEDICAL CARE
+47 SET BUDTIEN=$ORDER(^BUDGCNTL("B","MEDICAL CARE PROVIDERS",0))
+48 SET Y=$$PRIMPROV^APCLV(V,"D")
IF $DATA(^BUDGCNTL(BUDTIEN,11,"B",Y))
SET BUDMEDV=BUDMEDV+1
SET BUDMEDVI=V
End DoDot:1
+49 ;NOW get all for table 6 dxs, same list but include duplicates
+50 SET V=0
FOR
SET V=$ORDER(^TMP($JOB,"VISITSLIST",V))
IF V'=+V
QUIT
Begin DoDot:1
+51 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+52 ;no prim prov disc
IF $$PRIMPROV^APCLV(V,"D")=""
QUIT
+53 IF '$DATA(^AUPNVPOV("AD",V))
QUIT
+54 ;must have a primary dx other than .9999
+55 SET Y=$$PRIMPOV^APCLV(V,"C")
IF Y=".9999"
QUIT
+56 SET BUDTIEN=$ORDER(^BUDGCNTL("B","CLINIC EXCLUSIONS",0))
+57 SET C=$$CLINIC^APCLV(V,"C")
+58 ;exclude these clinics
IF C]""
IF $DATA(^BUDGCNTL(BUDTIEN,11,"B",C))
QUIT
+59 IF $PIECE(^AUPNVSIT(V,0),U,7)="E"
QUIT
+60 SET BUDT6V=BUDT6V+1
+61 SET ^TMP($JOB,"VISITS6DX",V)=""
+62 QUIT
End DoDot:1
+63 ;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
+64 ;not a patient of interest
IF BUDT35V=0
QUIT
+65 ;Q:'$D(^BWP(DFN))
+66 SET T="MAMMOGRAM SCREENING"
SET T=$ORDER(^BWPN("B",T,0))
+67 SET T1="MAMMOGRAM DX BILAT"
SET T1=$ORDER(^BWPN("B",T1,0))
+68 SET T2="MAMMOGRAM DX UNILAT"
SET T2=$ORDER(^BWPN("B",T2,0))
+69 IF $$VERSION^XPDUTL("BW")<3
Begin DoDot:1
+70 SET (G,V)=0
FOR
SET V=$ORDER(^BWPCD("C",DFN,V))
IF V=""
QUIT
Begin DoDot:2
+71 IF '$DATA(^BWPCD(V,0))
QUIT
+72 SET D=$PIECE(^BWPCD(V,0),U,12)
+73 SET J=$PIECE(^BWPCD(V,0),U,4)
IF J=T!(J=T1)!(J=T2)
Begin DoDot:3
+74 IF D<BUDBD
QUIT
+75 IF D>BUDED
QUIT
+76 ;already in pcc
IF $PIECE($GET(^BWPCD(V,"PCC")),U,1)]""
QUIT
+77 SET L=$PIECE(^BWPCD(V,0),U,10)
+78 IF L=""
QUIT
+79 ;not valid location
IF '$DATA(^BUDGSITE(BUDSITE,11,L))
QUIT
+80 SET ^TMP($JOB,"MAMMS",V)="WH "_$$VAL^XBDIQ1(9002086.1,V,.04)_U_$$FMTE^XLFDT(D)
End DoDot:3
QUIT
End DoDot:2
+81 QUIT
End DoDot:1
+82 ;;E D
+83 ;.S T="MAMMOGRAM SCREENING",T=$O(^BWVPDT("B",T,0))
+84 ;.S T1="MAMMOGRAM DX BILAT",T1=$O(^BWVPDT("B",T1,0))
+85 ;.S T2="MAMMOGRAM DX UNILAT",T2=$O(^BWVPDT("B",T2,0))
+86 ;.S D=$$FINDLSTD^BWVPRD(DFN,T_"^"_T1_"^"_T2,BUDBD,BUDED)
+87 ;.Q:D=0
+88 ;.Q:D=""
+89 ;.;check location here
+90 ;.S ^TMP($J,"MAMMS",1)="WH MAMMOGRAM "_U_$$FMTE^XLFDT(D)_U_D
+91 SET T="PAP SMEAR"
SET T=$ORDER(^BWPN("B",T,0))
+92 IF $$VERSION^XPDUTL("BW")<3
Begin DoDot:1
+93 SET (G,V)=0
FOR
SET V=$ORDER(^BWPCD("C",DFN,V))
IF V=""
QUIT
Begin DoDot:2
+94 IF '$DATA(^BWPCD(V,0))
QUIT
+95 SET D=$PIECE(^BWPCD(V,0),U,12)
+96 SET J=$PIECE(^BWPCD(V,0),U,4)
IF J=T
Begin DoDot:3
+97 IF D<BUDBD
QUIT
+98 IF D>BUDED
QUIT
+99 ;already in pcc
IF $PIECE($GET(^BWPCD(V,"PCC")),U,1)]""
QUIT
+100 SET L=$PIECE(^BWPCD(V,0),U,10)
+101 IF L=""
QUIT
+102 ;not valid location
IF '$DATA(^BUDGSITE(BUDSITE,11,L))
QUIT
+103 SET ^TMP($JOB,"PAPS",V)="WH PAP SMEAR"_U_$$FMTE^XLFDT(D)
End DoDot:3
QUIT
End DoDot:2
+104 QUIT
End DoDot:1
+105 ;E D
+106 ;.S T="PAP SMEAR",T=$O(^BWVPDT("B",T,0))
+107 ;.S D=$$FINDLSTD^BWVPRD(DFN,T,BUDBD,BUDED)
+108 ;.Q:D=0
+109 ;.Q:D=""
+110 ;.;check location here
+111 ;.S ^TMP($J,"PAPS",1)="WH PAP SMEAR "_U_$$FMTE^XLFDT(D)_U_D
+112 ;.S ^DIBT(4370,1,DFN)=""
+113 ;.Q
+114 QUIT
