- BGP3DCLP ; IHS/CMI/LAB - IHS gpra print ;
- ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
- ;
- CPPL1 ;EP
- Q:$G(BGPAREAA)
- ;
- S BGPCNT=BGPCPLC,BGPPCNT=0
- I BGPCNT<11!(BGPLIST'="R") S BGPCNT=1 G GO
- I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
- S BGPCNT=10
- GO ;
- S BGPQUIT="",BGPGPG=0,BGPYH1P=1
- S BGPXL=1 D HEADER
- S BGPY=$O(^BGPCTRL("B",2013,0))
- S BGPX=0 F S BGPX=$O(^BGPCTRL(BGPY,28,BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
- .I BGPPTYPE="P",$Y>(IOSL-2) D HEADER Q:BGPQUIT
- .D W^BGP3DP(^BGPCTRL(BGPY,28,BGPX,0),0,1,BGPPTYPE)
- S BGPXL=0
- D HEADER
- S BGPCOM="",BGPCOUNT=0 F S BGPCOM=$O(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM)) Q:BGPCOM=""!(BGPQUIT) D CPL1
- D W^BGP3DP("Total # of patients on list: "_+$G(BGPPCNT),0,2,BGPPTYPE)
- D W^BGP3DP("",0,1,BGPPTYPE)
- Q
- CPL1 ;EP
- S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT) D CPL2
- Q
- CPL2 ;
- S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT) D
- .S DFN=0 F S DFN=$O(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN!(BGPQUIT) S BGPCOUNT=BGPCOUNT+1 D PRINTL
- .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
- Q
- PRINTL ;print one line
- Q:(BGPCOUNT#BGPCNT)
- I BGPPTYPE="P",$Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
- S BGPPCNT=BGPPCNT+1
- D W^BGP3DP($E($P(^DPT(DFN,0),U),1,22),0,1,BGPPTYPE,1)
- D W^BGP3DP($$HRN^AUPNPAT(DFN,DUZ(2)),0,0,BGPPTYPE,2,24)
- D W^BGP3DP($E(BGPCOM,1,14),0,0,BGPPTYPE,3,31)
- D W^BGP3DP(BGPSEX,0,0,BGPPTYPE,4,46)
- D W^BGP3DP(BGPAGE,0,0,BGPPTYPE,5,49)
- S W="",X=$P(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) F Y=1:1:12 I $P(X,"$$",Y)]"" S:W]"" W=W_"," S W=W_$P(X,"$$",Y)
- S Z="",X=$P(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) F Y=1:1 Q:$P(X,"#",Y)="" S:Z]"" Z=Z_", " S Z=Z_$P(X,"#",Y)
- D W^BGP3DP(W,0,0,BGPPTYPE,6,53)
- D W^BGP3DP(Z_$S(BGPPTYPE="P":"/",1:""),0,0,BGPPTYPE,7,53)
- D W^BGP3DP($$LAST(DFN,BGPED),0,0,BGPPTYPE,8,65)
- Q
- ;
- LAST(P,EDATE) ;EP
- I '$D(^AUPNVSIT("AC",P)) Q ""
- K ^TMP($J,"A")
- S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT($$FMADD^XLFDT(EDATE,-(365*3)))_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
- I '$D(^TMP($J,"A",1)) Q ""
- K ^TMP($J,"A","VDO")
- S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X S V=$P(^TMP($J,"A",X),U,5) S ^TMP($J,"A","VDO",(9999999-$P($P(^AUPNVSIT(V,0),U),".")),X)=^TMP($J,"A",X)
- S (X,G,D)=0 F S D=$O(^TMP($J,"A","VDO",D)) Q:D'=+D!(G) S X=0 F S X=$O(^TMP($J,"A","VDO",D,X)) Q:X'=+X!(G) S V=$P(^TMP($J,"A",X),U,5) D
- .Q:'$D(^AUPNVSIT(V,0))
- .Q:'$P(^AUPNVSIT(V,0),U,9)
- .Q:$P(^AUPNVSIT(V,0),U,11)
- .Q:'$D(^AUPNVPRV("AD",V))
- .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
- .;Q:"V"[$P(^AUPNVSIT(V,0),U,3)
- .Q:$P(^AUPNVSIT(V,0),U,6)=""
- .;I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
- .S G=V
- .Q
- I G Q $$PRIMPROV^APCLV(G,"N")_","_$S($$PRIMPROV^APCLV(G,"F"):$P(^DIC(7,+$$PRIMPROV^APCLV(G,"F"),0),U,2),1:"")_","_$$DATE^BGP3UTL($P($P(^AUPNVSIT(G,0),U),"."))
- Q ""
- I BGPPTYPE="D" G HEADER1
- G:'BGPGPG HEADER1
- K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT=1 Q
- I BGPPTYPE="P" W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
- I BGPPTYPE="P",$G(BGPGUI) D W^BGP3DP("ZZZZZZZ",0,1,BGPPTYPE) ;! ;maw
- D W^BGP3DP("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",1,$S(BGPPTYPE="D":3,1:1),BGPPTYPE)
- I BGPPTYPE="P" S X=$P(^VA(200,DUZ,0),U,2),$E(X,35)=$$FMTE^XLFDT(DT),$E(X,70)="Page "_BGPGPG D W^BGP3DP(X,1,1,BGPPTYPE)
- D W^BGP3DP("*** IHS 2013 Comprehensive National GPRA/GPRAMA Patient List ***",1,1,BGPPTYPE)
- D W^BGP3DP("*** List of Patients Not Meeting a National GPRA or PART measure ***",1,1,BGPPTYPE)
- D W^BGP3DP($$RPTVER^BGP3BAN,1,1,BGPPTYPE)
- D W^BGP3DP($P(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
- S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP3DP(X,1,1,BGPPTYPE)
- D W^BGP3DP($S(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),1,1,BGPPTYPE)
- D W^BGP3DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
- Q:BGPXL
- H1 ;
- D W^BGP3DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,1,BGPPTYPE)
- D W^BGP3DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt",0,1,BGPPTYPE)
- D W^BGP3DP("",0,1,BGPPTYPE)
- D W^BGP3DP("PATIENT NAME",0,1,BGPPTYPE)
- D W^BGP3DP("HRN",0,0,BGPPTYPE,2,24)
- D W^BGP3DP("COMMUNITY",0,0,BGPPTYPE,3,31)
- D W^BGP3DP("SEX",0,0,BGPPTYPE,4,45)
- D W^BGP3DP("AGE",0,0,BGPPTYPE,5,49)
- D W^BGP3DP("DENOMINATOR",0,0,BGPPTYPE,6,53)
- D W^BGP3DP("NOT MET/LST PRVDR",0,0,BGPPTYPE,7,65)
- D W^BGP3DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
- Q
- CTR(X,Y) ;EP - Center X in a field Y wide.
- Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
- ;----------
- USR() ;EP - Return name of current user from ^VA(200.
- Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
- ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- ;----------
- BGP3DCLP ; IHS/CMI/LAB - IHS gpra print ;
- +1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
- +2 ;
- CPPL1 ;EP
- +1 IF $GET(BGPAREAA)
- QUIT
- +2 ;
- +3 SET BGPCNT=BGPCPLC
- SET BGPPCNT=0
- +4 IF BGPCNT<11!(BGPLIST'="R")
- SET BGPCNT=1
- GOTO GO
- +5 IF BGPCNT<100
- SET BGPCNT=BGPCNT\10
- GOTO GO
- +6 SET BGPCNT=10
- GO ;
- +1 SET BGPQUIT=""
- SET BGPGPG=0
- SET BGPYH1P=1
- +2 SET BGPXL=1
- DO HEADER
- +3 SET BGPY=$ORDER(^BGPCTRL("B",2013,0))
- +4 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPCTRL(BGPY,28,BGPX))
- IF BGPX'=+BGPX!(BGPQUIT)
- QUIT
- Begin DoDot:1
- +5 IF BGPPTYPE="P"
- IF $Y>(IOSL-2)
- DO HEADER
- IF BGPQUIT
- QUIT
- +6 DO W^BGP3DP(^BGPCTRL(BGPY,28,BGPX,0),0,1,BGPPTYPE)
- End DoDot:1
- +7 SET BGPXL=0
- +8 DO HEADER
- +9 SET BGPCOM=""
- SET BGPCOUNT=0
- FOR
- SET BGPCOM=$ORDER(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM))
- IF BGPCOM=""!(BGPQUIT)
- QUIT
- DO CPL1
- +10 DO W^BGP3DP("Total # of patients on list: "_+$GET(BGPPCNT),0,2,BGPPTYPE)
- +11 DO W^BGP3DP("",0,1,BGPPTYPE)
- +12 QUIT
- CPL1 ;EP
- +1 SET BGPSEX=""
- FOR
- SET BGPSEX=$ORDER(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX))
- IF BGPSEX=""!(BGPQUIT)
- QUIT
- DO CPL2
- +2 QUIT
- CPL2 ;
- +1 SET BGPAGE=""
- FOR
- SET BGPAGE=$ORDER(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE))
- IF BGPAGE=""!(BGPQUIT)
- QUIT
- Begin DoDot:1
- +2 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN))
- IF DFN'=+DFN!(BGPQUIT)
- QUIT
- SET BGPCOUNT=BGPCOUNT+1
- DO PRINTL
- +3 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-3)
- DO HEADER
- IF BGPQUIT
- QUIT
- End DoDot:1
- +4 QUIT
- PRINTL ;print one line
- +1 IF (BGPCOUNT#BGPCNT)
- QUIT
- +2 IF BGPPTYPE="P"
- IF $Y>(BGPIOSL-2)
- DO HEADER
- IF BGPQUIT
- QUIT
- +3 SET BGPPCNT=BGPPCNT+1
- +4 DO W^BGP3DP($EXTRACT($PIECE(^DPT(DFN,0),U),1,22),0,1,BGPPTYPE,1)
- +5 DO W^BGP3DP($$HRN^AUPNPAT(DFN,DUZ(2)),0,0,BGPPTYPE,2,24)
- +6 DO W^BGP3DP($EXTRACT(BGPCOM,1,14),0,0,BGPPTYPE,3,31)
- +7 DO W^BGP3DP(BGPSEX,0,0,BGPPTYPE,4,46)
- +8 DO W^BGP3DP(BGPAGE,0,0,BGPPTYPE,5,49)
- +9 SET W=""
- SET X=$PIECE(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
- FOR Y=1:1:12
- IF $PIECE(X,"$$",Y)]""
- IF W]""
- SET W=W_","
- SET W=W_$PIECE(X,"$$",Y)
- +10 SET Z=""
- SET X=$PIECE(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
- FOR Y=1:1
- IF $PIECE(X,"#",Y)=""
- QUIT
- IF Z]""
- SET Z=Z_", "
- SET Z=Z_$PIECE(X,"#",Y)
- +11 DO W^BGP3DP(W,0,0,BGPPTYPE,6,53)
- +12 DO W^BGP3DP(Z_$SELECT(BGPPTYPE="P":"/",1:""),0,0,BGPPTYPE,7,53)
- +13 DO W^BGP3DP($$LAST(DFN,BGPED),0,0,BGPPTYPE,8,65)
- +14 QUIT
- +15 ;
- LAST(P,EDATE) ;EP
- +1 IF '$DATA(^AUPNVSIT("AC",P))
- QUIT ""
- +2 KILL ^TMP($JOB,"A")
- +3 SET A="^TMP($J,""A"","
- SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT($$FMADD^XLFDT(EDATE,-(365*3)))_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(B,A)
- +4 IF '$DATA(^TMP($JOB,"A",1))
- QUIT ""
- +5 KILL ^TMP($JOB,"A","VDO")
- +6 SET (X,G)=0
- FOR
- SET X=$ORDER(^TMP($JOB,"A",X))
- IF X'=+X
- QUIT
- SET V=$PIECE(^TMP($JOB,"A",X),U,5)
- SET ^TMP($JOB,"A","VDO",(9999999-$PIECE($PIECE(^AUPNVSIT(V,0),U),".")),X)=^TMP($JOB,"A",X)
- +7 SET (X,G,D)=0
- FOR
- SET D=$ORDER(^TMP($JOB,"A","VDO",D))
- IF D'=+D!(G)
- QUIT
- SET X=0
- FOR
- SET X=$ORDER(^TMP($JOB,"A","VDO",D,X))
- IF X'=+X!(G)
- QUIT
- SET V=$PIECE(^TMP($JOB,"A",X),U,5)
- Begin DoDot:1
- +8 IF '$DATA(^AUPNVSIT(V,0))
- QUIT
- +9 IF '$PIECE(^AUPNVSIT(V,0),U,9)
- QUIT
- +10 IF $PIECE(^AUPNVSIT(V,0),U,11)
- QUIT
- +11 IF '$DATA(^AUPNVPRV("AD",V))
- QUIT
- +12 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
- QUIT
- +13 ;Q:"V"[$P(^AUPNVSIT(V,0),U,3)
- +14 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
- QUIT
- +15 ;I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
- +16 SET G=V
- +17 QUIT
- End DoDot:1
- +18 IF G
- QUIT $$PRIMPROV^APCLV(G,"N")_","_$SELECT($$PRIMPROV^APCLV(G,"F"):$PIECE(^DIC(7,+$$PRIMPROV^APCLV(G,"F"),0),U,2),1:"")_","_$$DATE^BGP3UTL($PIECE($PIECE(^AUPNVSIT(G,0),U),"."))
- +19 QUIT ""
- +1 IF BGPPTYPE="D"
- GOTO HEADER1
- +2 IF 'BGPGPG
- GOTO HEADER1
- +3 KILL DIR
- IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- IF '$DATA(ZTQUEUED)
- WRITE !
- SET DIR(0)="EO"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="^")!($DATA(DTOUT))
- SET BGPQUIT=1
- QUIT
- +1 IF BGPPTYPE="P"
- IF $DATA(IOF)
- WRITE @IOF
- SET BGPGPG=BGPGPG+1
- +2 ;! ;maw
- IF BGPPTYPE="P"
- IF $GET(BGPGUI)
- DO W^BGP3DP("ZZZZZZZ",0,1,BGPPTYPE)
- +3 DO W^BGP3DP("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",1,$SELECT(BGPPTYPE="D":3,1:1),BGPPTYPE)
- +4 IF BGPPTYPE="P"
- SET X=$PIECE(^VA(200,DUZ,0),U,2)
- SET $EXTRACT(X,35)=$$FMTE^XLFDT(DT)
- SET $EXTRACT(X,70)="Page "_BGPGPG
- DO W^BGP3DP(X,1,1,BGPPTYPE)
- +5 DO W^BGP3DP("*** IHS 2013 Comprehensive National GPRA/GPRAMA Patient List ***",1,1,BGPPTYPE)
- +6 DO W^BGP3DP("*** List of Patients Not Meeting a National GPRA or PART measure ***",1,1,BGPPTYPE)
- +7 DO W^BGP3DP($$RPTVER^BGP3BAN,1,1,BGPPTYPE)
- +8 DO W^BGP3DP($PIECE(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
- +9 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
- DO W^BGP3DP(X,1,1,BGPPTYPE)
- +10 DO W^BGP3DP($SELECT(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),1,1,BGPPTYPE)
- +11 DO W^BGP3DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
- +12 IF BGPXL
- QUIT
- H1 ;
- +1 DO W^BGP3DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,1,BGPPTYPE)
- +2 DO W^BGP3DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt",0,1,BGPPTYPE)
- +3 DO W^BGP3DP("",0,1,BGPPTYPE)
- +4 DO W^BGP3DP("PATIENT NAME",0,1,BGPPTYPE)
- +5 DO W^BGP3DP("HRN",0,0,BGPPTYPE,2,24)
- +6 DO W^BGP3DP("COMMUNITY",0,0,BGPPTYPE,3,31)
- +7 DO W^BGP3DP("SEX",0,0,BGPPTYPE,4,45)
- +8 DO W^BGP3DP("AGE",0,0,BGPPTYPE,5,49)
- +9 DO W^BGP3DP("DENOMINATOR",0,0,BGPPTYPE,6,53)
- +10 DO W^BGP3DP("NOT MET/LST PRVDR",0,0,BGPPTYPE,7,65)
- +11 DO W^BGP3DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
- +12 QUIT
- CTR(X,Y) ;EP - Center X in a field Y wide.
- +1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
- +2 ;----------
- USR() ;EP - Return name of current user from ^VA(200.
- +1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
- +2 ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- +1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- +2 ;----------
