BGP8DCLD ; IHS/CMI/LAB - IHS gpra print ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
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,BGPH1P=1
S X=" " D S(X,3,1)
D HEADER
S BGPY=$O(^BGPCTRL("B",2018,0))
S BGPX=0 F S BGPX=$O(^BGPCTRL(BGPY,28,BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
.S X=^BGPCTRL(BGPY,28,BGPX,0) D S(X,1,1)
D H1
S BGPH1P=0 S BGPCOM="",BGPCOUNT=0 F S BGPCOM=$O(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM)) Q:BGPCOM="" D CPL1
S X="Total # of patients on list: "_$G(BGPPCNT) D S(X,1,1)
Q
CPL1 ;EP
S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX)) Q:BGPSEX="" D CPL2
Q
CPL2 ;
S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE="" D
.S DFN=0 F S DFN=$O(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN S BGPCOUNT=BGPCOUNT+1 D PRINTL
Q
S(Y,F,P) ;set up array
I '$G(F) S F=0
S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%
I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
S $P(^TMP($J,"BGPDEL",%),U,P)=Y
Q
PRINTL ;print one line
Q:(BGPCOUNT#BGPCNT)
S BGPPCNT=BGPPCNT+1
S X=$E($P(^DPT(DFN,0),U),1,22) D S(X,1,1) S X=$$HRN^AUPNPAT(DFN,DUZ(2)) D S(X,,2) S X=BGPCOM D S(X,,3) S X=BGPSEX D S(X,,4) S X=BGPAGE D S(X,,5)
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 S(W,,6),S(Z,,7)
S A=$$LAST^BGP8DCLP(DFN,BGPED) D S(A,,8)
Q
;
S X="**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****" D S(X,1,1)
S X="*** IHS 2018 Comprehensive National GPRA Patient List ***" D S(X,1,1)
S X="*** List of Patients Not Meeting a National GPRA measure ***" D S(X,1,1)
S X=$$RPTVER^BGP8BAN D S(X,1,1)
S X=$P(^DIC(4,DUZ(2),0),U) D S(X,1,1)
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D S(X,1,1)
S X=$S(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV) D S(X,1,1)
S X=$TR($J("",80)," ","-") D S(X,1,1)
Q
H1 ;
S X=" " D S(X,1,1)
S X="UP=User Pop; AC=Active Clinical; UPDM=User Pop Diabetic; AD=Active Diabetic;" D S(X,1,1) S X="AAD=Active Adult Diabetic; PREG=Pregnant Female;" D S(X,1,1) S X="IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease" D S(X,1,1)
S X=" " D S(X,1,1)
S X="PATIENT NAME" D S(X,1,1) S X="HRN" D S(X,,2) S X="COMMUNITY" D S(X,,3) S X="SEX" D S(X,,4) S X="AGE" D S(X,,5) S X="DENOMINATOR" D S(X,,6) S X="MEASURE NOT MET" D S(X,,7) S X="LST PRVDR" D S(X,,8)
S X=$TR($J("",80)," ","-") D S(X,1,1)
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")
;----------
BGP8DCLD ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+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 BGPH1P=1
+2 SET X=" "
DO S(X,3,1)
+3 DO HEADER
+4 SET BGPY=$ORDER(^BGPCTRL("B",2018,0))
+5 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPCTRL(BGPY,28,BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:1
+6 SET X=^BGPCTRL(BGPY,28,BGPX,0)
DO S(X,1,1)
End DoDot:1
+7 DO H1
+8 SET BGPH1P=0
SET BGPCOM=""
SET BGPCOUNT=0
FOR
SET BGPCOM=$ORDER(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM))
IF BGPCOM=""
QUIT
DO CPL1
+9 SET X="Total # of patients on list: "_$GET(BGPPCNT)
DO S(X,1,1)
+10 QUIT
CPL1 ;EP
+1 SET BGPSEX=""
FOR
SET BGPSEX=$ORDER(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX))
IF BGPSEX=""
QUIT
DO CPL2
+2 QUIT
CPL2 ;
+1 SET BGPAGE=""
FOR
SET BGPAGE=$ORDER(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE))
IF BGPAGE=""
QUIT
Begin DoDot:1
+2 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN))
IF DFN'=+DFN
QUIT
SET BGPCOUNT=BGPCOUNT+1
DO PRINTL
End DoDot:1
+3 QUIT
S(Y,F,P) ;set up array
+1 IF '$GET(F)
SET F=0
+2 SET %=$PIECE(^TMP($JOB,"BGPDEL",0),U)+F
SET $PIECE(^TMP($JOB,"BGPDEL",0),U)=%
+3 IF '$DATA(^TMP($JOB,"BGPDEL",%))
SET ^TMP($JOB,"BGPDEL",%)=""
+4 SET $PIECE(^TMP($JOB,"BGPDEL",%),U,P)=Y
+5 QUIT
PRINTL ;print one line
+1 IF (BGPCOUNT#BGPCNT)
QUIT
+2 SET BGPPCNT=BGPPCNT+1
+3 SET X=$EXTRACT($PIECE(^DPT(DFN,0),U),1,22)
DO S(X,1,1)
SET X=$$HRN^AUPNPAT(DFN,DUZ(2))
DO S(X,,2)
SET X=BGPCOM
DO S(X,,3)
SET X=BGPSEX
DO S(X,,4)
SET X=BGPAGE
DO S(X,,5)
+4 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)
+5 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)
+6 DO S(W,,6)
DO S(Z,,7)
+7 SET A=$$LAST^BGP8DCLP(DFN,BGPED)
DO S(A,,8)
+8 QUIT
+9 ;
+1 SET X="**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
DO S(X,1,1)
+2 SET X="*** IHS 2018 Comprehensive National GPRA Patient List ***"
DO S(X,1,1)
+3 SET X="*** List of Patients Not Meeting a National GPRA measure ***"
DO S(X,1,1)
+4 SET X=$$RPTVER^BGP8BAN
DO S(X,1,1)
+5 SET X=$PIECE(^DIC(4,DUZ(2),0),U)
DO S(X,1,1)
+6 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
DO S(X,1,1)
+7 SET X=$SELECT(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV)
DO S(X,1,1)
+8 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO S(X,1,1)
+9 QUIT
H1 ;
+1 SET X=" "
DO S(X,1,1)
+2 SET X="UP=User Pop; AC=Active Clinical; UPDM=User Pop Diabetic; AD=Active Diabetic;"
DO S(X,1,1)
SET X="AAD=Active Adult Diabetic; PREG=Pregnant Female;"
DO S(X,1,1)
SET X="IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease"
DO S(X,1,1)
+3 SET X=" "
DO S(X,1,1)
+4 SET X="PATIENT NAME"
DO S(X,1,1)
SET X="HRN"
DO S(X,,2)
SET X="COMMUNITY"
DO S(X,,3)
SET X="SEX"
DO S(X,,4)
SET X="AGE"
DO S(X,,5)
SET X="DENOMINATOR"
DO S(X,,6)
SET X="MEASURE NOT MET"
DO S(X,,7)
SET X="LST PRVDR"
DO S(X,,8)
+5 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO S(X,1,1)
+6 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 ;----------
