- BUD7RPTD ; 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
- 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(^BUDESITE(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(^BUDECNTL("B","FIRST LEVEL CLINIC EXCLUSIONS",0))
- .I C]"",$D(^BUDECNTL(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(^BUDECNTL("B","CLINIC EXCLUSIONS",0))
- .S C=$$CLINIC^APCLV(V,"C")
- .I C]"",$D(^BUDECNTL(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 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(^BUDECNTL("B","CLINIC EXCLUSIONS",0))
- .S C=$$CLINIC^APCLV(V,"C")
- .I C]"",$D(^BUDECNTL(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(^BUDESITE(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(^BUDESITE(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
- BUD7RPTD ; 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
- +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(^BUDESITE(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(^BUDECNTL("B","FIRST LEVEL CLINIC EXCLUSIONS",0))
- +26 ;not a clinic code we want in any table
- IF C]""
- IF $DATA(^BUDECNTL(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(^BUDECNTL("B","CLINIC EXCLUSIONS",0))
- +39 SET C=$$CLINIC^APCLV(V,"C")
- +40 ;exclude these clinics
- IF C]""
- IF $DATA(^BUDECNTL(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)=""
- End DoDot:1
- +46 ;NOW get all for table 6 dxs, same list but include duplicates
- +47 SET V=0
- FOR
- SET V=$ORDER(^TMP($JOB,"VISITSLIST",V))
- IF V'=+V
- QUIT
- Begin DoDot:1
- +48 IF '$DATA(^AUPNVPRV("AD",V))
- QUIT
- +49 ;no prim prov disc
- IF $$PRIMPROV^APCLV(V,"D")=""
- QUIT
- +50 IF '$DATA(^AUPNVPOV("AD",V))
- QUIT
- +51 ;must have a primary dx other than .9999
- +52 SET Y=$$PRIMPOV^APCLV(V,"C")
- IF Y=".9999"
- QUIT
- +53 SET BUDTIEN=$ORDER(^BUDECNTL("B","CLINIC EXCLUSIONS",0))
- +54 SET C=$$CLINIC^APCLV(V,"C")
- +55 ;exclude these clinics
- IF C]""
- IF $DATA(^BUDECNTL(BUDTIEN,11,"B",C))
- QUIT
- +56 IF $PIECE(^AUPNVSIT(V,0),U,7)="E"
- QUIT
- +57 SET BUDT6V=BUDT6V+1
- +58 SET ^TMP($JOB,"VISITS6DX",V)=""
- +59 QUIT
- End DoDot:1
- +60 ;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
- +61 ;not a patient of interest
- IF BUDT35V=0
- QUIT
- +62 ;Q:'$D(^BWP(DFN))
- +63 SET T="MAMMOGRAM SCREENING"
- SET T=$ORDER(^BWPN("B",T,0))
- +64 SET T1="MAMMOGRAM DX BILAT"
- SET T1=$ORDER(^BWPN("B",T1,0))
- +65 SET T2="MAMMOGRAM DX UNILAT"
- SET T2=$ORDER(^BWPN("B",T2,0))
- +66 IF $$VERSION^XPDUTL("BW")<3
- Begin DoDot:1
- +67 SET (G,V)=0
- FOR
- SET V=$ORDER(^BWPCD("C",DFN,V))
- IF V=""
- QUIT
- Begin DoDot:2
- +68 IF '$DATA(^BWPCD(V,0))
- QUIT
- +69 SET D=$PIECE(^BWPCD(V,0),U,12)
- +70 SET J=$PIECE(^BWPCD(V,0),U,4)
- IF J=T!(J=T1)!(J=T2)
- Begin DoDot:3
- +71 IF D<BUDBD
- QUIT
- +72 IF D>BUDED
- QUIT
- +73 ;already in pcc
- IF $PIECE($GET(^BWPCD(V,"PCC")),U,1)]""
- QUIT
- +74 SET L=$PIECE(^BWPCD(V,0),U,10)
- +75 IF L=""
- QUIT
- +76 ;not valid location
- IF '$DATA(^BUDESITE(BUDSITE,11,L))
- QUIT
- +77 SET ^TMP($JOB,"MAMMS",V)="WH "_$$VAL^XBDIQ1(9002086.1,V,.04)_U_$$FMTE^XLFDT(D)
- End DoDot:3
- QUIT
- End DoDot:2
- +78 QUIT
- End DoDot:1
- +79 ;;E D
- +80 ;.S T="MAMMOGRAM SCREENING",T=$O(^BWVPDT("B",T,0))
- +81 ;.S T1="MAMMOGRAM DX BILAT",T1=$O(^BWVPDT("B",T1,0))
- +82 ;.S T2="MAMMOGRAM DX UNILAT",T2=$O(^BWVPDT("B",T2,0))
- +83 ;.S D=$$FINDLSTD^BWVPRD(DFN,T_"^"_T1_"^"_T2,BUDBD,BUDED)
- +84 ;.Q:D=0
- +85 ;.Q:D=""
- +86 ;.;check location here
- +87 ;.S ^TMP($J,"MAMMS",1)="WH MAMMOGRAM "_U_$$FMTE^XLFDT(D)_U_D
- +88 SET T="PAP SMEAR"
- SET T=$ORDER(^BWPN("B",T,0))
- +89 IF $$VERSION^XPDUTL("BW")<3
- Begin DoDot:1
- +90 SET (G,V)=0
- FOR
- SET V=$ORDER(^BWPCD("C",DFN,V))
- IF V=""
- QUIT
- Begin DoDot:2
- +91 IF '$DATA(^BWPCD(V,0))
- QUIT
- +92 SET D=$PIECE(^BWPCD(V,0),U,12)
- +93 SET J=$PIECE(^BWPCD(V,0),U,4)
- IF J=T
- Begin DoDot:3
- +94 IF D<BUDBD
- QUIT
- +95 IF D>BUDED
- QUIT
- +96 ;already in pcc
- IF $PIECE($GET(^BWPCD(V,"PCC")),U,1)]""
- QUIT
- +97 SET L=$PIECE(^BWPCD(V,0),U,10)
- +98 IF L=""
- QUIT
- +99 ;not valid location
- IF '$DATA(^BUDESITE(BUDSITE,11,L))
- QUIT
- +100 SET ^TMP($JOB,"PAPS",V)="WH PAP SMEAR"_U_$$FMTE^XLFDT(D)
- End DoDot:3
- QUIT
- End DoDot:2
- +101 QUIT
- End DoDot:1
- +102 ;E D
- +103 ;.S T="PAP SMEAR",T=$O(^BWVPDT("B",T,0))
- +104 ;.S D=$$FINDLSTD^BWVPRD(DFN,T,BUDBD,BUDED)
- +105 ;.Q:D=0
- +106 ;.Q:D=""
- +107 ;.;check location here
- +108 ;.S ^TMP($J,"PAPS",1)="WH PAP SMEAR "_U_$$FMTE^XLFDT(D)_U_D
- +109 ;.S ^DIBT(4370,1,DFN)=""
- +110 ;.Q
- +111 QUIT