- BGP3PDLS ; IHS/CMI/LAB - IHS gpra print ;
- ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
- ;
- START ;
- Q:$G(BGPAREAA)
- Q:$G(BGPCPPL)
- Q:'$D(BGPLIST)
- I $G(BGPNPL) Q
- 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("BGP3D",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="**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****" D S(X,1,1)
- .S X=$P(^BGPINDH(BGPL,0),U,3) D S(X,1,1)
- .S X=" " D S(X,1,1)
- .S X="Denominator(s):" D S(X,1,1)
- .S BGPNODE=$S(BGPRTYPE=1:81,BGPRTYPE=4:61,BGPRTYPE=7:83,BGPRTYPE=9:85,1:61)
- .S BGPX=0 F S BGPX=$O(^BGPINDH(BGPIC,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX D
- ..S BGPY=0 F S BGPY=$O(^BGPINDH(BGPIC,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
- ...;I $P(^BGPINDH(BGPIC,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
- ...;I '$D(^BGPINDH(BGPIC,61,BGPY,11,"B",BGPRTYPE)) Q
- ...I BGPRTYPE=4,'$D(^BGPINDH(BGPIC,BGPNODE,BGPY,12,"B",BGPINDH)) Q
- ...S BGPZ=0 F S BGPZ=$O(^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
- ....S Y=^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ,0) 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 BGPNODE=$S(BGPRTYPE=1:82,BGPRTYPE=4:62,BGPRTYPE=7:84,BGPRTYPE=9:86,1:62)
- .S BGPX=0 F S BGPX=$O(^BGPINDH(BGPIC,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX D
- ..S BGPY=0 F S BGPY=$O(^BGPINDH(BGPIC,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
- ...;I $P(^BGPINDH(BGPIC,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
- ...;I BGPRTYPE=4,BGPINDH'="S",$P(^BGPINDH(BGPIC,62,BGPY,0),U,3)'[BGPINDH Q ;don't display
- ...;I '$D(^BGPINDH(BGPIC,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
- ...I BGPRTYPE=4,'$D(^BGPINDH(BGPIC,BGPNODE,BGPY,12,"B",BGPINDH)) Q
- ...S BGPZ=0 F S BGPZ=$O(^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
- ....S X=^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ,0) D S(X,1,1)
- ....Q
- ...Q
- ..Q
- .S X=" " D S(X,1,1)
- .S BGPNODE=11
- .I BGPRTYPE=1,$O(^BGPINDH(BGPL,54,0)) S BGPNODE=54
- .I BGPRTYPE=7,$O(^BGPINDH(BGPL,56,0)) S BGPNODE=56
- .S X="Logic" D S(X,1,1)
- .S BGPX=0 F S BGPX=$O(^BGPINDH(BGPL,BGPNODE,BGPX)) Q:BGPX'=+BGPX D
- ..S X=^BGPINDH(BGPL,BGPNODE,BGPX,0) D S(X,1,1)
- .S X=" " D S(X,1,1) S X="Performance Measure Description" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPINDH(BGPL,51,BGPX)) Q:BGPX'=+BGPX D
- ..S X=^BGPINDH(BGPL,51,BGPX,0) D S(X,1,1)
- .I $O(^BGPINDH(BGPL,52,0)) S X=" " D S(X,1,1) S X="Past Performance and/or Target" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPINDH(BGPL,52,BGPX)) Q:BGPX'=+BGPX D
- ..S X=^BGPINDH(BGPL,52,BGPX,0) D S(X,1,1)
- .I $O(^BGPINDH(BGPL,55,0)) S X=" " D S(X,1,1) S X="Source" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPINDH(BGPL,55,BGPX)) Q:BGPX'=+BGPX D
- ..S X=^BGPINDH(BGPL,55,BGPX,0) D S(X,1,1)
- .D:'$G(BGPSUMON) H1
- .S BGPCOM="" F S BGPCOM=$O(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL,BGPCOM)) Q:BGPCOM="" D
- ..S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX)) Q:BGPSEX="" D
- ...S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE="" D
- ....S DFN=0 F S DFN=$O(^XTMP("BGP3D",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=$P(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) D S(X,,6)
- S X=$P(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) D S(X,,7)
- Q
- ;
- 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
- W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
- W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
- W !,$$CTR("*** IHS 2013 Clinical Performance Measure Patient List ***",80),!
- W $$CTR($P(^DIC(4,DUZ(2),0),U),80),!
- S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W $$CTR(X,80),!
- W $$CTR($S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),80),!
- W !,$TR($J("",80)," ","-")
- Q
- H1 ;
- S X=" " D S(X,1,1)
- S X=$S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV) D S(X,1,1)
- 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) D
- .S X="IMM=Active IMM Pkg Pt; CHD=Active Coronary Heart Disease;"_$S(BGPRTYPE=1:" HR=High Risk Patient",1:"") D S(X,1,1)
- S X=" " D S(X,1,1)
- S Y=0 F S Y=$O(^BGPINDH(BGPL,71,Y)) Q:Y'=+Y S X=^BGPINDH(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="DENOMINATOR" D S(X,,6) S X="NUMERATOR" D S(X,,7)
- 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")
- ;----------
- BGP3PDLS ; IHS/CMI/LAB - IHS gpra print ;
- +1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
- +2 ;
- START ;
- +1 IF $GET(BGPAREAA)
- QUIT
- +2 IF $GET(BGPCPPL)
- QUIT
- +3 IF '$DATA(BGPLIST)
- QUIT
- +4 IF $GET(BGPNPL)
- QUIT
- +5 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)
- +6 ;S BGPL=0 F S BGPL=$O(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL)) Q:BGPL'=+BGPL D
- +7 SET BGPL=0
- FOR
- SET BGPL=$ORDER(BGPLIST(BGPL))
- IF BGPL'=+BGPL
- QUIT
- Begin DoDot:1
- +8 SET BGPCOUNT=0
- SET BGPPCNT=0
- +9 SET BGPCNT=$GET(BGPLIST(BGPL))
- +10 IF 'BGPCNT
- SET BGPCNT=0
- +11 IF BGPCNT<11!(BGPLIST'="R")
- SET BGPCNT=1
- GOTO GO
- +12 IF BGPCNT<100
- SET BGPCNT=BGPCNT\10
- GOTO GO
- +13 SET BGPCNT=10
- GO ;
- +1 SET X="**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
- DO S(X,1,1)
- +2 SET X=$PIECE(^BGPINDH(BGPL,0),U,3)
- DO S(X,1,1)
- +3 SET X=" "
- DO S(X,1,1)
- +4 SET X="Denominator(s):"
- DO S(X,1,1)
- +5 SET BGPNODE=$SELECT(BGPRTYPE=1:81,BGPRTYPE=4:61,BGPRTYPE=7:83,BGPRTYPE=9:85,1:61)
- +6 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDH(BGPIC,BGPNODE,"B",BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +7 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPINDH(BGPIC,BGPNODE,"B",BGPX,BGPY))
- IF BGPY'=+BGPY
- QUIT
- Begin DoDot:3
- +8 ;I $P(^BGPINDH(BGPIC,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
- +9 ;I '$D(^BGPINDH(BGPIC,61,BGPY,11,"B",BGPRTYPE)) Q
- +10 IF BGPRTYPE=4
- IF '$DATA(^BGPINDH(BGPIC,BGPNODE,BGPY,12,"B",BGPINDH))
- QUIT
- +11 SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ))
- IF BGPZ'=+BGPZ
- QUIT
- Begin DoDot:4
- +12 SET Y=^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ,0)
- DO S(Y,1,1)
- +13 QUIT
- End DoDot:4
- +14 QUIT
- End DoDot:3
- +15 QUIT
- End DoDot:2
- +16 SET X=" "
- DO S(X,1,1)
- +17 SET X="Numerator(s):"
- DO S(X,1,1)
- +18 SET BGPNODE=$SELECT(BGPRTYPE=1:82,BGPRTYPE=4:62,BGPRTYPE=7:84,BGPRTYPE=9:86,1:62)
- +19 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDH(BGPIC,BGPNODE,"B",BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +20 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^BGPINDH(BGPIC,BGPNODE,"B",BGPX,BGPY))
- IF BGPY'=+BGPY
- QUIT
- Begin DoDot:3
- +21 ;I $P(^BGPINDH(BGPIC,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
- +22 ;I BGPRTYPE=4,BGPINDH'="S",$P(^BGPINDH(BGPIC,62,BGPY,0),U,3)'[BGPINDH Q ;don't display
- +23 ;I '$D(^BGPINDH(BGPIC,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
- +24 IF BGPRTYPE=4
- IF '$DATA(^BGPINDH(BGPIC,BGPNODE,BGPY,12,"B",BGPINDH))
- QUIT
- +25 SET BGPZ=0
- FOR
- SET BGPZ=$ORDER(^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ))
- IF BGPZ'=+BGPZ
- QUIT
- Begin DoDot:4
- +26 SET X=^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ,0)
- DO S(X,1,1)
- +27 QUIT
- End DoDot:4
- +28 QUIT
- End DoDot:3
- +29 QUIT
- End DoDot:2
- +30 SET X=" "
- DO S(X,1,1)
- +31 SET BGPNODE=11
- +32 IF BGPRTYPE=1
- IF $ORDER(^BGPINDH(BGPL,54,0))
- SET BGPNODE=54
- +33 IF BGPRTYPE=7
- IF $ORDER(^BGPINDH(BGPL,56,0))
- SET BGPNODE=56
- +34 SET X="Logic"
- DO S(X,1,1)
- +35 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDH(BGPL,BGPNODE,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +36 SET X=^BGPINDH(BGPL,BGPNODE,BGPX,0)
- DO S(X,1,1)
- End DoDot:2
- +37 SET X=" "
- DO S(X,1,1)
- SET X="Performance Measure Description"
- DO S(X,1,1)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDH(BGPL,51,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +38 SET X=^BGPINDH(BGPL,51,BGPX,0)
- DO S(X,1,1)
- End DoDot:2
- +39 IF $ORDER(^BGPINDH(BGPL,52,0))
- SET X=" "
- DO S(X,1,1)
- SET X="Past Performance and/or Target"
- DO S(X,1,1)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDH(BGPL,52,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +40 SET X=^BGPINDH(BGPL,52,BGPX,0)
- DO S(X,1,1)
- End DoDot:2
- +41 IF $ORDER(^BGPINDH(BGPL,55,0))
- SET X=" "
- DO S(X,1,1)
- SET X="Source"
- DO S(X,1,1)
- SET BGPX=0
- FOR
- SET BGPX=$ORDER(^BGPINDH(BGPL,55,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +42 SET X=^BGPINDH(BGPL,55,BGPX,0)
- DO S(X,1,1)
- End DoDot:2
- +43 IF '$GET(BGPSUMON)
- DO H1
- +44 SET BGPCOM=""
- FOR
- SET BGPCOM=$ORDER(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL,BGPCOM))
- IF BGPCOM=""
- QUIT
- Begin DoDot:2
- +45 SET BGPSEX=""
- FOR
- SET BGPSEX=$ORDER(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX))
- IF BGPSEX=""
- QUIT
- Begin DoDot:3
- +46 SET BGPAGE=""
- FOR
- SET BGPAGE=$ORDER(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE))
- IF BGPAGE=""
- QUIT
- Begin DoDot:4
- +47 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN))
- IF DFN'=+DFN
- QUIT
- SET BGPCOUNT=BGPCOUNT+1
- DO PRINTL
- +48 QUIT
- End DoDot:4
- +49 QUIT
- End DoDot:3
- +50 QUIT
- End DoDot:2
- +51 SET X=" "
- DO S(X,1,1)
- SET X=" "
- DO S(X,1,1)
- +52 SET X=" "
- DO S(X,1,1)
- SET X=" "
- DO S(X,1,1)
- +53 SET X="Total # of patients on list: "_+$GET(BGPPCNT)
- DO S(X,1,1)
- End DoDot:1
- +54 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)
- +4 SET X=$PIECE(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
- DO S(X,,6)
- +5 SET X=$PIECE(^XTMP("BGP3D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
- DO S(X,,7)
- +6 QUIT
- +7 ;
- +1 IF 'BGPGPG
- GOTO HEADER1
- +2 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 $DATA(IOF)
- WRITE @IOF
- SET BGPGPG=BGPGPG+1
- +2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
- +3 WRITE !,$$CTR("*** IHS 2013 Clinical Performance Measure Patient List ***",80),!
- +4 WRITE $$CTR($PIECE(^DIC(4,DUZ(2),0),U),80),!
- +5 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
- WRITE $$CTR(X,80),!
- +6 WRITE $$CTR($SELECT(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),80),!
- +7 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
- +8 QUIT
- H1 ;
- +1 SET X=" "
- DO S(X,1,1)
- +2 SET X=$SELECT(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV)
- DO S(X,1,1)
- +3 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)
- Begin DoDot:1
- +4 SET X="IMM=Active IMM Pkg Pt; CHD=Active Coronary Heart Disease;"_$SELECT(BGPRTYPE=1:" HR=High Risk Patient",1:"")
- DO S(X,1,1)
- End DoDot:1
- +5 SET X=" "
- DO S(X,1,1)
- +6 SET Y=0
- FOR
- SET Y=$ORDER(^BGPINDH(BGPL,71,Y))
- IF Y'=+Y
- QUIT
- SET X=^BGPINDH(BGPL,71,Y,0)
- DO S(X,1,1)
- +7 SET X=" "
- DO S(X,1,1)
- +8 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="NUMERATOR"
- DO S(X,,7)
- +9 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
- DO S(X,1,1)
- +10 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 ;----------
