- BGP6DPEE ; IHS/CMI/LAB - IHS gpra print ;
- ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- ;
- START ;
- Q:$G(BGPAREAA)
- Q:'$D(BGPLIST)
- S X=" " D S(X,1,1) D S(X,1,1) D S(X,1,1) S X="PATIENT LISTS" D S(X,1,1) S X=" " D S(X,1,1)
- ;S BGPL=0 F S BGPL=$O(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL)) Q:BGPL'=+BGPL D
- S BGPL=0 F S BGPL=$O(BGPLIST(BGPL)) Q:BGPL'=+BGPL D
- .S BGPCOUNT=0,BGPPCNT=0
- .S BGPCNT=$G(BGPLIST(BGPL))
- .S:'BGPCNT BGPCNT=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 X=" " D S(X,1,1) D S(X,1,1)
- .S X="**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****" D S(X,1,1)
- .S X=$P(^BGPPEIM(BGPL,0),U,2) D S(X,1,1)
- .S X=" " D S(X,1,1)
- .I $G(BGPDNT) G CALC
- .S X="Denominator(s):" D S(X,1,1)
- .S BGPX=0 F S BGPX=$O(^BGPPEIM(BGPL,61,"B",BGPX)) Q:BGPX'=+BGPX D
- ..S BGPY=0 F S BGPY=$O(^BGPPEIM(BGPL,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
- ...S BGPZ=0 F S BGPZ=$O(^BGPPEIM(BGPL,61,BGPY,11,BGPZ)) Q:BGPZ'=+BGPZ D
- ....S Y=^BGPPEIM(BGPL,61,BGPY,11,BGPZ,0) S:BGPZ=1 Y=" - "_Y D S(Y,1,1)
- ....Q
- ...Q
- ..Q
- .S X=" " D S(X,1,1)
- .S X="Numerator(s):" D S(X,1,1)
- .S BGPX=0 F S BGPX=$O(^BGPPEIM(BGPL,62,"B",BGPX)) Q:BGPX'=+BGPX D
- ..S BGPY=0 F S BGPY=$O(^BGPPEIM(BGPL,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
- ...S BGPZ=0 F S BGPZ=$O(^BGPPEIM(BGPL,62,BGPY,11,BGPZ)) Q:BGPZ'=+BGPZ D
- ....S X=^BGPPEIM(BGPL,62,BGPY,11,BGPZ,0) S:BGPZ=1 X=" - "_X D S(X,1,1)
- ....Q
- ...Q
- ..Q
- .S X=" " D S(X,1,1)
- .S BGPNODE=11
- .S BGPX=0 F S BGPX=$O(^BGPPEIM(BGPL,BGPNODE,BGPX)) Q:BGPX'=+BGPX D
- ..S X=^BGPPEIM(BGPL,BGPNODE,BGPX,0) D S(X,1,1)
- .S X=" " D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPPEIM(BGPL,51,BGPX)) Q:BGPX'=+BGPX D
- ..S X=^BGPPEIM(BGPL,51,BGPX,0) D S(X,1,1)
- .S X=" " D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPPEIM(BGPL,52,BGPX)) Q:BGPX'=+BGPX D
- ..S X=^BGPPEIM(BGPL,52,BGPX,0) D S(X,1,1)
- CALC .D H1
- .S BGPCOM="" F S BGPCOM=$O(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM)) Q:BGPCOM="" D
- ..S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX)) Q:BGPSEX="" D
- ...S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE="" D
- ....S DFN=0 F S DFN=$O(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN S BGPCOUNT=BGPCOUNT+1 D PRINTL
- ....Q
- ...Q
- ..Q
- .S X=" " D S(X,1,1) S X=" " D S(X,1,1)
- .S X=" " D S(X,1,1) S X=" " D S(X,1,1)
- .S X="Total # of patients on list: "_+$G(BGPPCNT) D S(X,1,1)
- 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=$E(BGPCOM,1,14) D S(X,,3) S X=BGPSEX D S(X,,4) S X=BGPAGE D S(X,,5) S X=$$EDT^BGP6UTL($$DOB^AUPNPAT(DFN)) D S(X,,6)
- S X="UP"_$S($P(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),U,2)=1:", UP PED",1:"") D S(X,,7)
- S X=$P(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),U,1) D S(X,,8)
- Q
- ;
- H1 ;
- ;S X=" " D S(X,1,1)
- S X=$S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",BGPLIST="O":"Patient List by Education provider: "_BGPEPROV,BGPLIST="E":"Patient List by Education Provider",1:"Patient List by Provider: "_BGPLPROV) D S(X,1,1)
- S X=" " D S(X,1,1) S X="UP=User Pop" D S(X,1,1)
- S X=" " D S(X,1,1)
- S Y=0 F S Y=$O(^BGPPEIM(BGPL,71,Y)) Q:Y'=+Y S X=^BGPPEIM(BGPL,71,Y,0) 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="DOB" D S(X,,6) S X="DENOMINATOR" D S(X,,7) S X="NUMERATOR" D S(X,,8)
- S X=$TR($J("",80)," ","-") D S(X,1,1)
- 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
- 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")
- ;----------
- BGP6DPEE ; IHS/CMI/LAB - IHS gpra print ;
- +1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- +2 ;
- START ;
- +1 IF $GET(BGPAREAA)
- QUIT
- +2 IF '$DATA(BGPLIST)
- QUIT
- +3 SET X=" "
- DO S(X,1,1)
- DO S(X,1,1)
- DO S(X,1,1)
- SET X="PATIENT LISTS"
- DO S(X,1,1)
- SET X=" "
- DO S(X,1,1)
- +4 ;S BGPL=0 F S BGPL=$O(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL)) Q:BGPL'=+BGPL D
- +5 SET BGPL=0
- FOR
- SET BGPL=$ORDER(BGPLIST(BGPL))
- IF BGPL'=+BGPL
- QUIT
- Begin DoDot:1
- +6 SET BGPCOUNT=0
- SET BGPPCNT=0
- +7 SET BGPCNT=$GET(BGPLIST(BGPL))
- +8 IF 'BGPCNT
- SET BGPCNT=0
- +9 IF BGPCNT<11!(BGPLIST'="R")
- SET BGPCNT=1
- GOTO GO
- +10 IF BGPCNT<100
- SET BGPCNT=BGPCNT\10
- GOTO GO
- +11 SET BGPCNT=10
- GO ;
- +1 SET X=" "
- DO S(X,1,1)
- DO S(X,1,1)
- +2 SET X="**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
- DO S(X,1,1)
- +3 SET X=$PIECE(^BGPPEIM(BGPL,0),U,2)
- DO S(X,1,1)
- +4 SET X=" "
- DO S(X,1,1)
- +5 IF $GET(BGPDNT)
- GOTO CALC
- +6 SET X="Denominator(s):"
- DO S(X,1,1)
- +7 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPPEIM(BGPL,61,"B",BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +8 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPPEIM(BGPL,61,"B",BGPX,BGPY))
- IF BGPY'=+BGPY
- QUIT
- Begin DoDot:3
- +9 SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPPEIM(BGPL,61,BGPY,11,BGPZ))
- IF BGPZ'=+BGPZ
- QUIT
- Begin DoDot:4
- +10 SET Y=^BGPPEIM(BGPL,61,BGPY,11,BGPZ,0)
- IF BGPZ=1
- SET Y=" - "_Y
- DO S(Y,1,1)
- +11 QUIT
- End DoDot:4
- +12 QUIT
- End DoDot:3
- +13 QUIT
- End DoDot:2
- +14 SET X=" "
- DO S(X,1,1)
- +15 SET X="Numerator(s):"
- DO S(X,1,1)
- +16 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPPEIM(BGPL,62,"B",BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +17 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPPEIM(BGPL,62,"B",BGPX,BGPY))
- IF BGPY'=+BGPY
- QUIT
- Begin DoDot:3
- +18 SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPPEIM(BGPL,62,BGPY,11,BGPZ))
- IF BGPZ'=+BGPZ
- QUIT
- Begin DoDot:4
- +19 SET X=^BGPPEIM(BGPL,62,BGPY,11,BGPZ,0)
- IF BGPZ=1
- SET X=" - "_X
- DO S(X,1,1)
- +20 QUIT
- End DoDot:4
- +21 QUIT
- End DoDot:3
- +22 QUIT
- End DoDot:2
- +23 SET X=" "
- DO S(X,1,1)
- +24 SET BGPNODE=11
- +25 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPPEIM(BGPL,BGPNODE,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +26 SET X=^BGPPEIM(BGPL,BGPNODE,BGPX,0)
- DO S(X,1,1)
- End DoDot:2
- +27 SET X=" "
- DO S(X,1,1)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPPEIM(BGPL,51,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +28 SET X=^BGPPEIM(BGPL,51,BGPX,0)
- DO S(X,1,1)
- End DoDot:2
- +29 SET X=" "
- DO S(X,1,1)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPPEIM(BGPL,52,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +30 SET X=^BGPPEIM(BGPL,52,BGPX,0)
- DO S(X,1,1)
- End DoDot:2
- CALC DO H1
- +1 SET BGPCOM=""
- FOR
- SET BGPCOM=$ORDER(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM))
- IF BGPCOM=""
- QUIT
- Begin DoDot:2
- +2 SET BGPSEX=""
- FOR
- SET BGPSEX=$ORDER(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX))
- IF BGPSEX=""
- QUIT
- Begin DoDot:3
- +3 SET BGPAGE=""
- FOR
- SET BGPAGE=$ORDER(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE))
- IF BGPAGE=""
- QUIT
- Begin DoDot:4
- +4 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN))
- IF DFN'=+DFN
- QUIT
- SET BGPCOUNT=BGPCOUNT+1
- DO PRINTL
- +5 QUIT
- End DoDot:4
- +6 QUIT
- End DoDot:3
- +7 QUIT
- End DoDot:2
- +8 SET X=" "
- DO S(X,1,1)
- SET X=" "
- DO S(X,1,1)
- +9 SET X=" "
- DO S(X,1,1)
- SET X=" "
- DO S(X,1,1)
- +10 SET X="Total # of patients on list: "_+$GET(BGPPCNT)
- DO S(X,1,1)
- End DoDot:1
- +11 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=$EXTRACT(BGPCOM,1,14)
- DO S(X,,3)
- SET X=BGPSEX
- DO S(X,,4)
- SET X=BGPAGE
- DO S(X,,5)
- SET X=$$EDT^BGP6UTL($$DOB^AUPNPAT(DFN))
- DO S(X,,6)
- +4 SET X="UP"_$SELECT($PIECE(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),U,2)=1:", UP PED",1:"")
- DO S(X,,7)
- +5 SET X=$PIECE(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),U,1)
- DO S(X,,8)
- +6 QUIT
- +7 ;
- H1 ;
- +1 ;S X=" " D S(X,1,1)
- +2 SET X=$SELECT(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",BGPLIST="O":"Patient List by Education provider: "_BGPEPROV,BGPLIST="E":"Patient List by Education Provider",1:"Patient List by Provider: "_BGPLPROV)
- DO S(X,1,1)
- +3 SET X=" "
- DO S(X,1,1)
- SET X="UP=User Pop"
- DO S(X,1,1)
- +4 SET X=" "
- DO S(X,1,1)
- +5 SET Y=0
- FOR
- SET Y=$ORDER(^BGPPEIM(BGPL,71,Y))
- IF Y'=+Y
- QUIT
- SET X=^BGPPEIM(BGPL,71,Y,0)
- DO S(X,1,1)
- +6 SET X=" "
- DO S(X,1,1)
- +7 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="DOB"
- DO S(X,,6)
- SET X="DENOMINATOR"
- DO S(X,,7)
- SET X="NUMERATOR"
- DO S(X,,8)
- +8 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
- DO S(X,1,1)
- +9 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
- 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 ;----------