BGP7PDH1 ; IHS/CMI/LAB - cover page for gpra del 0 ;
;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
;
;
;
PEHDR ;EP
S BGPX=$O(^BGPCTRL("B",2017,0))
S BGPNODEP=$S($G(BGPSEAT):75,1:34)
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY D
.Q:X["ENDCOVERPAGE"
.S X=^BGPCTRL(BGPX,BGPNODEP,BGPY,0) D SET(X,1,1)
.Q
S X=" " D SET(X,1,1)
Q
PEDCP ;EP
D PEHDR
I BGPROT'="P",'$D(BGPGUI) D
.S X="A delimited output file called "_BGPDELF D SET(X,1,1)
.S X="has been placed in the "_$$GETDEDIR^BGP7UTL2()_" directory for your use in Excel or some" D SET(X,1,1) S X="other software package. See your site manager to access this file." D SET(X,1,1)
S X=" " D SET(X,1,1)
NEW BGPX
S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX="" D
.S X=$P(^BGPPEDCG(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
.S BGPC=BGPC+1,X=BGPC_". "_$S($P(^BGPPEDCG(BGPX,0),U,17):"*",1:"")_X D SET(X,1,1)
.Q
S X=" " D SET(X,1,1)
S X="The following communities are included in this report:" D SET(X,1,1)
S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX="" D
.S X=$P(^BGPPEDCG(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
.S BGPC=BGPC+1,X=BGPC_". "_$S($P(^BGPPEDCG(BGPX,0),U,17):"*",1:"")_X D SET(X,1,1)
.S X="Communities: " D SET(X,1,1) S X=0,N=0,Y="",Z="" F S X=$O(^BGPPEDCG(BGPX,9999,X)) Q:X'=+X S N=N+1,Y=Y_$S(N=1:"",1:";")_$P(^BGPPEDCG(BGPX,9999,X,0),U)
.S X=0,C=0 F X=1:3:N S Z=$E($P(Y,";",X),1,20),$P(Z,U,2)=$E($P(Y,";",(X+1)),1,20),$P(Z,U,3)=$E($P(Y,";",(X+2)),1,20) D SET(Z,1,1)
.S X=" " D SET(X,1,1)
.Q
S X=" " D SET(X,1,1)
K BGPX,BGPQUIT
Q
;
SET(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
COMHDR ;EP
S X=" " D SET(X,1,1)
Q:$G(BGPSEAT)
S BGPNODEP=17
S BGPX=$O(^BGPCTRL("B",2017,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY D
.S X=^BGPCTRL(BGPX,BGPNODEP,BGPY,0) D SET(X,1,1)
.Q
S X=" " D SET(X,1,1)
I $G(BGPYGPU) D SET("See last pages of this report for Performance Summaries.",1,1) D SET(" ",1,1)
Q
GPRAHDRS ;EP
S X=" " D SET(X,1,1)
S BGPNODEP=76
S BGPX=$O(^BGPCTRL("B",2017,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY D
.S X=^BGPCTRL(BGPX,BGPNODEP,BGPY,0) D SET(X,1,1)
.Q
S X=" " D SET(X,1,1)
Q
PPHDR ;EP
S X=" " D SET(X,1,1)
;Q:$G(BGPSEAT)
S BGPX=$O(^BGPCTRL("B",2017,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,18,BGPY)) Q:BGPY'=+BGPY D
.S X=^BGPCTRL(BGPX,18,BGPY,0) D SET(X,1,1)
.Q
S X=" " D SET(X,1,1)
Q
ALLHDR ;EP
S X=" " D SET(X,1,1)
Q:$G(BGPSEAT)
S BGPNODEP=19
S BGPX=$O(^BGPCTRL("B",2017,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY D
.S X=^BGPCTRL(BGPX,BGPNODEP,BGPY,0) D SET(X,1,1)
.Q
S X=" " D SET(X,1,1)
Q
DENOMHDR ;EP
S X=" " D SET(X,1,1)
Q:$G(BGPSEAT)
S BGPX=$O(^BGPCTRL("B",2017,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,13,BGPY)) Q:BGPY'=+BGPY D
.S X=^BGPCTRL(BGPX,13,BGPY,0) D SET(X,1,1)
.Q
S X=" " D SET(X,1,1)
Q
BGP7PDH1 ; IHS/CMI/LAB - cover page for gpra del 0 ;
+1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
+2 ;
+3 ;
+4 ;
PEHDR ;EP
+1 SET BGPX=$ORDER(^BGPCTRL("B",2017,0))
+2 SET BGPNODEP=$SELECT($GET(BGPSEAT):75,1:34)
+3 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:1
+4 IF X["ENDCOVERPAGE"
QUIT
+5 SET X=^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
DO SET(X,1,1)
+6 QUIT
End DoDot:1
+7 SET X=" "
DO SET(X,1,1)
+8 QUIT
PEDCP ;EP
+1 DO PEHDR
+2 IF BGPROT'="P"
IF '$DATA(BGPGUI)
Begin DoDot:1
+3 SET X="A delimited output file called "_BGPDELF
DO SET(X,1,1)
+4 SET X="has been placed in the "_$$GETDEDIR^BGP7UTL2()_" directory for your use in Excel or some"
DO SET(X,1,1)
SET X="other software package. See your site manager to access this file."
DO SET(X,1,1)
End DoDot:1
+5 SET X=" "
DO SET(X,1,1)
+6 NEW BGPX
+7 SET BGPX=""
SET BGPC=0
FOR
SET BGPX=$ORDER(BGPSUL(BGPX))
IF BGPX=""
QUIT
Begin DoDot:1
+8 SET X=$PIECE(^BGPPEDCG(BGPX,0),U,9)
SET X=$ORDER(^AUTTLOC("C",X,0))
SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
+9 SET BGPC=BGPC+1
SET X=BGPC_". "_$SELECT($PIECE(^BGPPEDCG(BGPX,0),U,17):"*",1:"")_X
DO SET(X,1,1)
+10 QUIT
End DoDot:1
+11 SET X=" "
DO SET(X,1,1)
+12 SET X="The following communities are included in this report:"
DO SET(X,1,1)
+13 SET BGPX=""
SET BGPC=0
FOR
SET BGPX=$ORDER(BGPSUL(BGPX))
IF BGPX=""
QUIT
Begin DoDot:1
+14 SET X=$PIECE(^BGPPEDCG(BGPX,0),U,9)
SET X=$ORDER(^AUTTLOC("C",X,0))
SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
+15 SET BGPC=BGPC+1
SET X=BGPC_". "_$SELECT($PIECE(^BGPPEDCG(BGPX,0),U,17):"*",1:"")_X
DO SET(X,1,1)
+16 SET X="Communities: "
DO SET(X,1,1)
SET X=0
SET N=0
SET Y=""
SET Z=""
FOR
SET X=$ORDER(^BGPPEDCG(BGPX,9999,X))
IF X'=+X
QUIT
SET N=N+1
SET Y=Y_$SELECT(N=1:"",1:";")_$PIECE(^BGPPEDCG(BGPX,9999,X,0),U)
+17 SET X=0
SET C=0
FOR X=1:3:N
SET Z=$EXTRACT($PIECE(Y,";",X),1,20)
SET $PIECE(Z,U,2)=$EXTRACT($PIECE(Y,";",(X+1)),1,20)
SET $PIECE(Z,U,3)=$EXTRACT($PIECE(Y,";",(X+2)),1,20)
DO SET(Z,1,1)
+18 SET X=" "
DO SET(X,1,1)
+19 QUIT
End DoDot:1
+20 SET X=" "
DO SET(X,1,1)
+21 KILL BGPX,BGPQUIT
+22 QUIT
+23 ;
SET(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
COMHDR ;EP
+1 SET X=" "
DO SET(X,1,1)
+2 IF $GET(BGPSEAT)
QUIT
+3 SET BGPNODEP=17
+4 SET BGPX=$ORDER(^BGPCTRL("B",2017,0))
+5 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:1
+6 SET X=^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
DO SET(X,1,1)
+7 QUIT
End DoDot:1
+8 SET X=" "
DO SET(X,1,1)
+9 IF $GET(BGPYGPU)
DO SET("See last pages of this report for Performance Summaries.",1,1)
DO SET(" ",1,1)
+10 QUIT
GPRAHDRS ;EP
+1 SET X=" "
DO SET(X,1,1)
+2 SET BGPNODEP=76
+3 SET BGPX=$ORDER(^BGPCTRL("B",2017,0))
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:1
+5 SET X=^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
DO SET(X,1,1)
+6 QUIT
End DoDot:1
+7 SET X=" "
DO SET(X,1,1)
+8 QUIT
PPHDR ;EP
+1 SET X=" "
DO SET(X,1,1)
+2 ;Q:$G(BGPSEAT)
+3 SET BGPX=$ORDER(^BGPCTRL("B",2017,0))
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,18,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:1
+5 SET X=^BGPCTRL(BGPX,18,BGPY,0)
DO SET(X,1,1)
+6 QUIT
End DoDot:1
+7 SET X=" "
DO SET(X,1,1)
+8 QUIT
ALLHDR ;EP
+1 SET X=" "
DO SET(X,1,1)
+2 IF $GET(BGPSEAT)
QUIT
+3 SET BGPNODEP=19
+4 SET BGPX=$ORDER(^BGPCTRL("B",2017,0))
+5 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:1
+6 SET X=^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
DO SET(X,1,1)
+7 QUIT
End DoDot:1
+8 SET X=" "
DO SET(X,1,1)
+9 QUIT
DENOMHDR ;EP
+1 SET X=" "
DO SET(X,1,1)
+2 IF $GET(BGPSEAT)
QUIT
+3 SET BGPX=$ORDER(^BGPCTRL("B",2017,0))
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,13,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:1
+5 SET X=^BGPCTRL(BGPX,13,BGPY,0)
DO SET(X,1,1)
+6 QUIT
End DoDot:1
+7 SET X=" "
DO SET(X,1,1)
+8 QUIT
