BGP8PDH1.m

BGP8PDH1 ; IHS/CMI/LAB - cover page for gpra del 0 ;

 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 ;

 ;

 ;

PEHDR ;EP

 S BGPX=$O(^BGPCTRL("B",2018,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^BGP8UTL2()_" 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(^BGPPEDCR(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(^BGPPEDCR(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(^BGPPEDCR(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(^BGPPEDCR(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(^BGPPEDCR(BGPX,9999,X)) Q:X'=+X  S N=N+1,Y=Y_$S(N=1:"",1:";")_$P(^BGPPEDCR(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",2018,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",2018,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",2018,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",2018,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",2018,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

BGP8PDH1  ; IHS/CMI/LAB - cover page for gpra del 0 ;

 +1       ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 +2       ;

 +3       ;

 +4       ;

PEHDR     ;EP

 +1        SET BGPX=$ORDER(^BGPCTRL("B",2018,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^BGP8UTL2()_" 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(^BGPPEDCR(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(^BGPPEDCR(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(^BGPPEDCR(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(^BGPPEDCR(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(^BGPPEDCR(BGPX,9999,X))

                       IF X'=+X

                           QUIT 

                       SET N=N+1

                       SET Y=Y_$SELECT(N=1:"",1:";")_$PIECE(^BGPPEDCR(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",2018,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",2018,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",2018,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",2018,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",2018,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