Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP9DPED

BGP9DPED.m

Go to the documentation of this file. 
  1. BGP9DPED ; IHS/CMI/LAB - IHS gpra print ;
  1.  ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 1, 2009
  1.  ;
  1.  ;
  1. PRINT ;
  1. DEL ;EP - create delimited output file
  1.  S BGPRTYPE=6,BGPRPTH=""
  1.  K ^TMP($J)
  1.  S ^TMP($J,"BGPDEL",0)=0
  1.  D ^BGP9PDLH
  1.  K BGPSUMP
  1.  D DEL1
  1.  D ^BGP9DPEE ;print lists to delimited file
  1.  ;if screen selected do screen
  1.  I BGPDELT="S" D SCREEN,EXIT Q
  1.  ;call xbgsave to create output file
  1.  S XBGL="BGPDATA"
  1.  L +^BGPDATA:300 E  W:'$D(ZTQUEUED) "Unable to lock global" Q
  1.  K ^BGPDATA ;global for saving
  1.  S X=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  S ^BGPDATA(X)=^TMP($J,"BGPDEL",X)
  1.  I '$D(BGPGUI) D
  1.  .S XBFLT=1,XBFN=BGPDELF_".txt",XBMED="F",XBTLE="GPRA 09 DELIMITED PT ED OUTPUT",XBQ="N",XBF=0
  1.  .D ^XBGSAVE
  1.  .K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
  1.  I $D(BGPGUI) D
  1.  .S (C,X)=0 F  S X=$O(^BGPDATA(X)) Q:X'=+X  S C=C+1,^BGPGUIN(BGPGIEN,12,C,0)=^BGPDATA(X)
  1.  .S ^BGPGUIN(BGPGIEN,12,0)="^90537.0812^"_C_"^"_C_"^"_DT
  1.  L -^BGPDATA
  1.  K ^BGPDATA ;export global
  1.  D EXIT
  1.  Q
  1.  ;
  1. SCREEN ;
  1.  S X=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  W !,^TMP($J,"BGPDEL",X)
  1.  Q
  1. DEL1 ;EP
  1.  S BGPIC=0 F  S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC=""  D
  1.  .;now print individual measure
  1.  .D S(" ",1,1),S(" ",1,1)
  1.  .S X=$P(^BGPPEIN(BGPIC,0),U,2) D S(X,1,1)
  1.  .D S(" ",1,1)
  1.  .S X="Denominator(s):" D S(X,1,1)
  1.  .S BGPX=0 F  S BGPX=$O(^BGPPEIN(BGPIC,61,"B",BGPX)) Q:BGPX'=+BGPX  D
  1.  ..S BGPY=0 F  S BGPY=$O(^BGPPEIN(BGPIC,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY  D
  1.  ...S BGPZ=0 F  S BGPZ=$O(^BGPPEIN(BGPIC,61,BGPY,11,BGPZ)) Q:BGPZ'=+BGPZ  D
  1.  ....S Y=^BGPPEIN(BGPIC,61,BGPY,11,BGPZ,0) D S(Y,1,1)
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .D S(" ",1,1)
  1.  .S X="Numerator(s):" D S(X,1,1)
  1.  .S BGPX=0 F  S BGPX=$O(^BGPPEIN(BGPIC,62,"B",BGPX)) Q:BGPX'=+BGPX  D
  1.  ..S BGPY=0 F  S BGPY=$O(^BGPPEIN(BGPIC,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY  D
  1.  ...S BGPZ=0 F  S BGPZ=$O(^BGPPEIN(BGPIC,62,BGPY,11,BGPZ)) Q:BGPZ'=+BGPZ  D
  1.  ....S X=^BGPPEIN(BGPIC,62,BGPY,11,BGPZ,0) D S(X,1,1)
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .D S(" ",1,1)
  1.  .S BGPNODE=11
  1.  .S BGPX=0 F  S BGPX=$O(^BGPPEIN(BGPIC,BGPNODE,BGPX)) Q:BGPX'=+BGPX  D
  1.  ..S X=^BGPPEIN(BGPIC,BGPNODE,BGPX,0) D S(X,1,1)
  1.  .D @BGPIC
  1.  Q
  1. EXIT ;
  1.  K ^TMP($J)
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. S(Y,F,P) ;EP set up array
  1.  I '$G(F) S F=0
  1.  S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%
  1.  I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
  1.  S $P(^TMP($J,"BGPDEL",%),U,P)=Y
  1.  Q
  1. C(X,X2,X3) ;
  1.  D COMMA^%DTC
  1.  Q X
  1.  ;
  1. 1 ;
  1.  D S(" ",1,1) ;S X=$P(^BGPPEIN(BGPIC,0),U,2) D S(X,1,1)
  1.  D H1^BGP9PDL1
  1.  D S(" ",1,1)
  1.  S BGPCYD=$$V(1,BGPRPT,11,1)
  1.  S BGPPRD=$$V(2,BGPRPT,11,1)
  1.  S BGPBLD=$$V(3,BGPRPT,11,1)
  1.  S X="User Pop" D S(X,1,1)
  1.  S Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD D S(Y,,2)
  1.  D S(" ",1,1)
  1.  S N=11,P=2 D SETN
  1.  S X="# w/ patient ed" D S(X,1,1)
  1.  D H2^BGP9PDL1
  1.  Q
  1. 2 ;
  1.  D S(" ",1,1) D S(" ",1,1) ;S X=$P(^BGPPEIN(BGPIC,0),U,2) D S(X,1,1)
  1.  D H1^BGP9PDL1
  1.  D S(" ",1,1)
  1.  S BGPCYD=$$V(1,BGPRPT,11,7)
  1.  S BGPPRD=$$V(2,BGPRPT,11,7)
  1.  S BGPBLD=$$V(3,BGPRPT,11,7)
  1.  S X="Total Time Spent" D S(X,1,1) S X="Providing Education (mins)" D S(X,1,1)
  1.  S Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD D S(Y,,2)
  1.  D S(" ",1,1)
  1.  K BGPPROVS
  1.  S N=12 D SETNM
  1.  K BGPX
  1.  S X="",C=0 F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
  1.  S BGP1=0,BGPCNT=0 F  S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1  D
  1.  .S BGP2=0 F  S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2  D
  1.  ..S X=$P(BGPX(BGP1,BGP2),U,2) D S(X,1,1)
  1.  ..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
  1.  ..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
  1.  ..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
  1.  ..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
  1.  ..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
  1.  ..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
  1.  ..D H2^BGP9PDL1
  1.  I '$G(BGPAREAA) D
  1.  .S BGPAA=$$V(1,BGPRPT,11,7)
  1.  .S BGPAB=$$V(2,BGPRPT,11,7)
  1.  .S BGPAC=$$V(3,BGPRPT,11,7)
  1.  .S BGPCYN=$$V(1,BGPRPT,11,6)
  1.  .S BGPPRN=$$V(2,BGPRPT,11,6)
  1.  .S BGPBLN=$$V(3,BGPRPT,11,6)
  1.  .S BGPCYD=$$V(1,BGPRPT,11,3)
  1.  .S BGPPRD=$$V(2,BGPRPT,11,3)
  1.  .S BGPBLD=$$V(3,BGPRPT,11,3)
  1.  I $G(BGPAREAA) D
  1.  .S BGPAA=$$V(1,BGPRPT,11,7)
  1.  .S BGPAB=$$V(2,BGPRPT,11,7)
  1.  .S BGPAC=$$V(3,BGPRPT,11,7)
  1.  .S BGPCYN=$$V(1,BGPRPT,11,6)
  1.  .S BGPPRN=$$V(2,BGPRPT,11,6)
  1.  .S BGPBLN=$$V(3,BGPRPT,11,6)
  1.  .S BGPCYD=$S(BGPAA:BGPAA/BGPCYN,1:0)
  1.  .S BGPPRD=$S(BGPAB:BGPAB/BGPPRN,1:0)
  1.  .S BGPBLD=$S(BGPAC:BGPAC/BGPBLN,1:0)
  1.  S X="" D S(X,1,1)
  1.  D S("Total # of Minutes recorded",1,1) D S("for All Providers",1,1)
  1.  S Y=BGPAA_"^^"_BGPAB_"^^^"_BGPAC D S(Y,,2)
  1.  D S("Total # of Pt Ed Codes with Provider",1,1) D S("and minutes recorded",1,1)
  1.  S Y=BGPCYN_"^^"_BGPPRN_"^^^"_BGPBLN D S(Y,,2)
  1.  D S(" ",1,1)
  1.  S X="Average Time Spent" D S(X,1,1) S X="All Providers (minutes)" D S(X,1,1)
  1.  S Y=$$SL(BGPCYD)_"^^"_$$SL(BGPPRD)_"^^^"_$$SL(BGPBLD) D S(Y,,2)
  1.  I '$G(BGPAREAA) D
  1.  .S BGPCYD=$$V(1,BGPRPT,11,4)
  1.  .S BGPPRD=$$V(2,BGPRPT,11,4)
  1.  .S BGPBLD=$$V(3,BGPRPT,11,4)
  1.  I $G(BGPAREAA) D
  1.  .S BGPCYD=999999999,BGPBLD=999999999,BGPPRD=999999999
  1.  .S X=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  D
  1.  ..I $P($G(^BGPPEDCN(X,11)),U,4)]"",$P(^BGPPEDCN(X,11),U,4)<BGPCYD S BGPCYD=$P(^BGPPEDCN(X,11),U,4)
  1.  ..I $P($G(^BGPPEDPN(X,11)),U,4)]"",$P(^BGPPEDPN(X,11),U,4)<BGPPRD S BGPPRD=$P(^BGPPEDPN(X,11),U,4)
  1.  ..I $P($G(^BGPPEDBN(X,11)),U,4)]"",$P(^BGPPEDBN(X,11),U,4)<BGPBLD S BGPBLD=$P(^BGPPEDBN(X,11),U,4)
  1.  .I BGPCYD=999999999 S BGPCYD=""
  1.  .I BGPBLD=999999999 S BGPBLD=""
  1.  .I BGPPRD=999999999 S BGPPRD=""
  1.  S X="" D S(X,1,1)
  1.  S X="Minimum Time Spent" D S(X,2,1) S X="All Provders (minutes)" D S(X,1,1)
  1.  S Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD D S(Y,,2)
  1.  I '$G(BGPAREAA) D
  1.  .S BGPCYD=$$V(1,BGPRPT,11,5)
  1.  .S BGPPRD=$$V(2,BGPRPT,11,5)
  1.  .S BGPBLD=$$V(3,BGPRPT,11,5)
  1.  I $G(BGPAREAA) D
  1.  .S (BGPCYD,BGPPRD,BGPBLD)=""
  1.  .S X=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  D
  1.  ..I $P($G(^BGPPEDCN(X,11)),U,5)>BGPCYD S BGPCYD=$P(^BGPPEDCN(X,11),U,5)
  1.  ..I $P($G(^BGPPEDPN(X,11)),U,5)>BGPPRD S BGPPRD=$P(^BGPPEDPN(X,11),U,5)
  1.  ..I $P($G(^BGPPEDBN(X,11)),U,5)>BGPBLD S BGPBLD=$P(^BGPPEDBN(X,11),U,5)
  1.  S X="" D S(X,1,1)
  1.  S X="Maximum Time Spent" D S(X,1,1) S X="All Providers (minutes)" D S(X,1,1)
  1.  S Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD D S(Y,,2)
  1.  Q
  1. 3 ;
  1.  S X=""
  1.  D S("  ",1,1) D S("  ",1,1) ;S X=$P(^BGPPEIN(BGPIC,0),U,2) D S(X,1,1)
  1.  D H1^BGP9PDL1
  1.  D S(" ",1,1)
  1.  S BGPCYD=$$V(1,BGPRPT,11,8)
  1.  S BGPPRD=$$V(2,BGPRPT,11,8)
  1.  S BGPBLD=$$V(3,BGPRPT,11,8)
  1.  S X="Total # Education Codes" D S(X,1,1)
  1.  S Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD D S(Y,,2)
  1.  D S(" ",1,1)
  1.  K BGPPROVS
  1.  S N=13 D SETNM
  1.  K BGPX
  1.  S BGPCNT=0
  1.  S X="",C=0 F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
  1.  S BGP1=0 F  S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPCNT>24)  D
  1.  .S BGPCNT=BGPCNT+1 S BGP2=0 F  S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2  D
  1.  ..S X=BGPCNT_".  "_$P(BGPX(BGP1,BGP2),U,2) D S(X,1,1)
  1.  ..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
  1.  ..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
  1.  ..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
  1.  ..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
  1.  ..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
  1.  ..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
  1.  ..D H2^BGP9PDL1
  1.  Q
  1. 4 ;
  1.  S X=""
  1.  D S(" ",1,1) D S(" ",1,1) ;S X=$P(^BGPPEIN(BGPIC,0),U,2) D S(X,1,1)
  1.  D H1^BGP9PDL1
  1.  D S(" ",1,1)
  1.  S BGPCYD=$$V(1,BGPRPT,11,9)
  1.  S BGPPRD=$$V(2,BGPRPT,11,9)
  1.  S BGPBLD=$$V(3,BGPRPT,11,9)
  1.  S X="Total # Education Codes" D S(X,1,1)
  1.  S Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD D S(Y,,2)
  1.  D S(" ",1,1)
  1.  K BGPPROVS
  1.  S N=14 D SETNM
  1.  K BGPX
  1.  S BGPCNT=0
  1.  S X="",C=0 F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
  1.  S BGP1=0 F  S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPCNT>24)  D
  1.  .S BGPCNT=BGPCNT+1 S BGP2=0 F  S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2  D
  1.  ..S X=BGPCNT_".  "_$P(BGPX(BGP1,BGP2),U,2) D S(X,1,1)
  1.  ..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
  1.  ..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
  1.  ..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
  1.  ..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
  1.  ..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
  1.  ..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
  1.  ..D H2^BGP9PDL1
  1.  Q
  1. 5 ;
  1.  S X=""
  1.  D S(" ",1,1) D S(" ",1,1) ;S X=$P(^BGPPEIN(BGPIC,0),U,2) D S(X,1,1)
  1.  D H1^BGP9PDL1
  1.  D S(" ",1,1)
  1.  S BGPCYD=$$V(1,BGPRPT,11,10)
  1.  S BGPPRD=$$V(2,BGPRPT,11,10)
  1.  S BGPBLD=$$V(3,BGPRPT,11,10)
  1.  S X="Total # Education Codes" D S(X,1,1)
  1.  S Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD D S(Y,,2)
  1.  D S(" ",1,1)
  1.  K BGPPROVS
  1.  S N=15 D SETNM
  1.  K BGPX
  1.  S BGPCNT=0
  1.  S X="",C=0 F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
  1.  S BGP1=0 F  S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPCNT>15)  D
  1.  .S BGPCNT=BGPCNT+1 S BGP2=0 F  S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2  D
  1.  ..S X=BGPCNT_".  "_$P(BGPX(BGP1,BGP2),U,2) D S(X,1,1)
  1.  ..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
  1.  ..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
  1.  ..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
  1.  ..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
  1.  ..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
  1.  ..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
  1.  ..D H2^BGP9PDL1
  1.  Q
  1. 6 ;
  1.  S X=""
  1.  D S(" ",1,1) D S(" ",1,1) ;S X=$P(^BGPPEIN(BGPIC,0),U,2) D S(X,1,1)
  1.  D H1^BGP9PDL1
  1.  D S(" ",1,1)
  1.  S BGPCYD=$$V(1,BGPRPT,11,12)
  1.  S BGPPRD=$$V(2,BGPRPT,11,12)
  1.  S BGPBLD=$$V(3,BGPRPT,11,12)
  1.  S X="Total # Education Codes" D S(X,1,1)
  1.  S Y=BGPCYD_"^^"_BGPPRD_"^^^"_BGPBLD D S(Y,,2)
  1.  D S(" ",1,1)
  1.  S X="Patient Understanding" D S(X,1,1)
  1.  S N=11,P=15 D SETN
  1.  S X="Good" D S(X,1,1)
  1.  D H2^BGP9PDL1
  1.  S N=11,P=14 D SETN
  1.  S X="Fair" D S(X,1,1)
  1.  D H2^BGP9PDL1
  1.  S N=11,P=13 D SETN
  1.  S X="Poor" D S(X,1,1)
  1.  D H2^BGP9PDL1
  1.  S N=11,P=16 D SETN
  1.  S X="Refused" D S(X,1,1)
  1.  D H2^BGP9PDL1
  1.  S N=11,P=17 D SETN
  1.  S X="Group-No Assessment" D S(X,1,1)
  1.  D H2^BGP9PDL1
  1.  S N=11,P=18 D SETN
  1.  S X="Blank (Not recorded)" D S(X,1,1)
  1.  D H2^BGP9PDL1
  1.  Q
  1. 7 ;
  1.  D 7^BGP9DPEF
  1.  Q
  1. KITM ;
  1.  K ^TMP($J)
  1.  K ^XTMP("BGP9PE",BGPJ,BGPH)
  1.  Q
  1. SETNM ;
  1.  K BGPPROVS
  1.  I $G(BGPAREAA) D SETNMA Q
  1.  S X=0 F  S X=$O(^BGPPEDCN(BGPRPT,N,X)) Q:X'=+X  D
  1.  .S C=$P(^BGPPEDCN(BGPRPT,N,X,0),U),L=$P(^BGPPEDCN(BGPRPT,N,X,0),U,2),M=$P(^BGPPEDCN(BGPRPT,N,X,0),U,3)
  1.  .I $D(BGPPROVS(C,L)) S $P(BGPPROVS(C,L),U,1)=M Q
  1.  .S $P(BGPPROVS(C,L),U,1)=M
  1.  S X=0 F  S X=$O(^BGPPEDPN(BGPRPT,N,X)) Q:X'=+X  D
  1.  .S C=$P(^BGPPEDPN(BGPRPT,N,X,0),U),L=$P(^BGPPEDPN(BGPRPT,N,X,0),U,2),M=$P(^BGPPEDPN(BGPRPT,N,X,0),U,3)
  1.  .I $D(BGPPROVS(C,L)) S $P(BGPPROVS(C,L),U,2)=M Q
  1.  .S $P(BGPPROVS(C,L),U,2)=M
  1.  S X=0 F  S X=$O(^BGPPEDBN(BGPRPT,N,X)) Q:X'=+X  D
  1.  .S C=$P(^BGPPEDBN(BGPRPT,N,X,0),U),L=$P(^BGPPEDBN(BGPRPT,N,X,0),U,2),M=$P(^BGPPEDBN(BGPRPT,N,X,0),U,3)
  1.  .I $D(BGPPROVS(C,L)) S $P(BGPPROVS(C,L),U,3)=M Q
  1.  .S $P(BGPPROVS(C,L),U,3)=M
  1.  ;set %ages
  1.  S X="" F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  D
  1.  .F Z=1:1:3 I $P(BGPPROVS(X,Y),U,Z)="" S $P(BGPPROVS(X,Y),U,Z)=0
  1.  .S A=$P(BGPPROVS(X,Y),U,1),$P(BGPPROVS(X,Y),U,4)=$S(BGPCYD:((A/BGPCYD)*100),1:"")
  1.  .S B=$P(BGPPROVS(X,Y),U,2),$P(BGPPROVS(X,Y),U,5)=$S(BGPPRD:((B/BGPPRD)*100),1:"")
  1.  .S C=$P(BGPPROVS(X,Y),U,3),$P(BGPPROVS(X,Y),U,6)=$S(BGPBLD:((C/BGPBLD)*100),1:"")
  1.  .Q
  1.  Q
  1. SETNMA ;
  1.  NEW X,V,C S Z=0,C="" F  S Z=$O(BGPSUL(Z)) Q:Z'=+Z  D SETNMA1
  1.  ;set %ages
  1.  S X="" F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  D
  1.  .F Z=1:1:3 I $P(BGPPROVS(X,Y),U,Z)="" S $P(BGPPROVS(X,Y),U,Z)=0
  1.  .S A=$P(BGPPROVS(X,Y),U,1),$P(BGPPROVS(X,Y),U,4)=$S(BGPCYD:((A/BGPCYD)*100),1:"")
  1.  .S B=$P(BGPPROVS(X,Y),U,2),$P(BGPPROVS(X,Y),U,5)=$S(BGPPRD:((B/BGPPRD)*100),1:"")
  1.  .S C=$P(BGPPROVS(X,Y),U,3),$P(BGPPROVS(X,Y),U,6)=$S(BGPBLD:((C/BGPBLD)*100),1:"")
  1.  .Q
  1.  Q
  1. SETNMA1 ;
  1.  S X=0 F  S X=$O(^BGPPEDCN(Z,N,X)) Q:X'=+X  D
  1.  .S C=$P(^BGPPEDCN(Z,N,X,0),U),L=$P(^BGPPEDCN(Z,N,X,0),U,2),M=$P(^BGPPEDCN(Z,N,X,0),U,3)
  1.  .;I $D(BGPPROVS(C,L)) S $P(BGPPROVS(C,L),U,1)=M Q
  1.  .S $P(BGPPROVS(C,L),U,1)=$P($G(BGPPROVS(C,L)),U,1)+M
  1.  S X=0 F  S X=$O(^BGPPEDPN(Z,N,X)) Q:X'=+X  D
  1.  .S C=$P(^BGPPEDPN(Z,N,X,0),U),L=$P(^BGPPEDPN(Z,N,X,0),U,2),M=$P(^BGPPEDPN(Z,N,X,0),U,3)
  1.  .;I $D(BGPPROVS(C,L)) S $P(BGPPROVS(C,L),U,2)=M Q
  1.  .S $P(BGPPROVS(C,L),U,2)=$P($G(BGPPROVS(C,L)),U,2)+M
  1.  S X=0 F  S X=$O(^BGPPEDBN(Z,N,X)) Q:X'=+X  D
  1.  .S C=$P(^BGPPEDBN(Z,N,X,0),U),L=$P(^BGPPEDBN(Z,N,X,0),U,2),M=$P(^BGPPEDBN(Z,N,X,0),U,3)
  1.  .;I $D(BGPPROVS(C,L)) S $P(BGPPROVS(C,L),U,3)=M Q
  1.  .S $P(BGPPROVS(C,L),U,3)=$P($G(BGPPROVS(C,L)),U,3)+M
  1.  .Q
  1.  Q
  1. SETN ;EP - set numerator fields
  1.  S BGPCYN=$$V(1,BGPRPT,N,P,2) ;SPDX
  1.  S BGPPRN=$$V(2,BGPRPT,N,P,2) ;SPDX
  1.  S BGPBLN=$$V(3,BGPRPT,N,P,2) ;SPDX
  1.  S BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
  1.  S BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
  1.  S BGPBLP=$S(BGPBLD:((BGPBLN/BGPBLD)*100),1:"")
  1.  Q
  1. SL(V) ;
  1.  I V="" S V=0
  1.  Q $$STRIP^XLFSTR($J(V,7,0)," ")
  1. V(T,R,N,P,ND) ;EP ;SPDX
  1.  I $G(BGPAREAA) G VA
  1.  NEW X
  1.  I T=1 S X=$P($G(^BGPPEDCN(R,N)),U,P) Q $S(X]"":X,1:0)
  1.  I T=2 S X=$P($G(^BGPPEDPN(R,N)),U,P) Q $S(X]"":X,1:0)
  1.  I T=3 S X=$P($G(^BGPPEDBN(R,N)),U,P) Q $S(X]"":X,1:0)
  1.  Q ""
  1. VA ;
  1.  NEW X,V,C S X=0,C="" F  S X=$O(BGPSUL(X)) Q:X'=+X  D
  1.  .I T=1 S C=C+$P($G(^BGPPEDCN(X,N)),U,P)
  1.  .I T=2 S C=C+$P($G(^BGPPEDPN(X,N)),U,P)
  1.  .I T=3 S C=C+$P($G(^BGPPEDBN(X,N)),U,P)
  1.  .Q
  1.  Q $S(C]"":C,1:0)