- BGP0DCLD ; IHS/CMI/LAB - IHS gpra print ;
- ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- ;
- 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",2010,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("BGP08CPL",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("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX)) Q:BGPSEX="" D CPL2
- Q
- CPL2 ;
- S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE="" D
- .S DFN=0 F S DFN=$O(^XTMP("BGP08CPL",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("BGP08CPL",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("BGP08CPL",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^BGP0DCLP(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 2010 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^BGP0BAN 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; 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")
- ;----------
- BGP0DCLD ; IHS/CMI/LAB - IHS gpra print ;
- +1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- +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",2010,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("BGP08CPL",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("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX))
- IF BGPSEX=""
- QUIT
- DO CPL2
- +2 QUIT
- CPL2 ;
- +1 SET BGPAGE=""
- FOR
- SET BGPAGE=$ORDER(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE))
- IF BGPAGE=""
- QUIT
- Begin DoDot:1
- +2 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BGP08CPL",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("BGP08CPL",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("BGP08CPL",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^BGP0DCLP(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 2010 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^BGP0BAN
- 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)
- SET X="UP=User Pop; AC=Active Clinical; 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)
- +2 SET X=" "
- DO S(X,1,1)
- +3 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)
- +4 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
- DO S(X,1,1)
- +5 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 ;----------