BGP8EL1L.m

BGP8EL1L ; IHS/CMI/LAB - print ind 1 ;

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

 ;

 ;PUBLIC HEALTH NURSING

IELDPHA ;EP

 D H1

 F BGPPC1="24.1","24.2" Q:BGPQUIT  W ! D PI

 Q

PI ;EP

 S BGPPC=0 F  S BGPPC=$O(^BGPELIIR("AP",BGPPC1,BGPPC)) Q:BGPPC=""  D PI1

 Q

PI1 ;

 K BGPCYP,BGPBLP,BGPPRD,BGPEXCT,BGPSDP

 S (BGPCYD,BGPPRD,BGPBLD)=""

 S BGPNF=$P(^BGPELIIR(BGPPC,0),U,9)

 S BGPNP=$P(^DD(90561.03,BGPNF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)

 D SETN^BGP8ELP1

 I $Y>(BGPIOSL-6) D HEADER^BGP8DPH Q:BGPQUIT  W !!,^BGPELIR(BGPIC,53,1,0) D H1

 S X=$$LABELE^BGP8UTL1(BGPPC,BGPRTYPE,BGPPTYPE,"N")

 W !,$P(X,U,1)

 F I=2:1 S Y=$P(X,U,I) Q:Y=""  W !," ",Y

 ;W !!,$P(^BGPELIIR(BGPPC,0),U,15)

 ;I $P(^BGPELIIR(BGPPC,0),U,16)]"" W !?1,$P(^BGPELIIR(BGPPC,0),U,16)

 ;I $P(^BGPELIIR(BGPPC,0),U,19)]"" W !?1,$P(^BGPELIIR(BGPPC,0),U,19)

 D H2

 Q

H2 ;EP

 S BGPX="",BGPX=$$C(BGPCYN,0,7),$E(BGPX,9)="",$E(BGPX,16)=$$C(BGPPRN,0,7),$E(BGPX,24)="",$E(BGPX,32)=$$CALC(BGPCYN,BGPPRN)

 S $E(BGPX,39)=$$C(BGPBLN,0,7),$E(BGPX,47)="",$E(BGPX,54)=$$CALC(BGPCYN,BGPBLN)

 W ?20,BGPX

 Q

H1 ;EP

 W !!?21,"REPORT",?31,"",?35,"PREV YR",?46,"",?49,"CHG from",?59,"BASE",?69,"",?72,"CHG from"

 W !?21,"PERIOD      ",?35,"PERIOD      ",?49,"PREV YR ",?59,"PERIOD     ",?72,"BASE "

 Q

CALC(N,O) ;ENTRY POINT

 NEW Z

 S Z=N-O,Z=$FN(Z,"+,",0)

 Q Z

C(X,X2,X3) ;

 D COMMA^%DTC

 Q X

BGP8EL1L  ; IHS/CMI/LAB - print ind 1 ;

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

 +2       ;

 +3       ;PUBLIC HEALTH NURSING

IELDPHA   ;EP

 +1        DO H1

 +2        FOR BGPPC1="24.1","24.2"

               IF BGPQUIT

                   QUIT 

               WRITE !

               DO PI

 +3        QUIT 

PI        ;EP

 +1        SET BGPPC=0

           FOR 

               SET BGPPC=$ORDER(^BGPELIIR("AP",BGPPC1,BGPPC))

               IF BGPPC=""

                   QUIT 

               DO PI1

 +2        QUIT 

PI1       ;

 +1        KILL BGPCYP,BGPBLP,BGPPRD,BGPEXCT,BGPSDP

 +2        SET (BGPCYD,BGPPRD,BGPBLD)=""

 +3        SET BGPNF=$PIECE(^BGPELIIR(BGPPC,0),U,9)

 +4        SET BGPNP=$PIECE(^DD(90561.03,BGPNF,0),U,4)

           SET N=$PIECE(BGPNP,";")

           SET P=$PIECE(BGPNP,";",2)

 +5        DO SETN^BGP8ELP1

 +6        IF $Y>(BGPIOSL-6)

               DO HEADER^BGP8DPH

               IF BGPQUIT

                   QUIT 

               WRITE !!,^BGPELIR(BGPIC,53,1,0)

               DO H1

 +7        SET X=$$LABELE^BGP8UTL1(BGPPC,BGPRTYPE,BGPPTYPE,"N")

 +8        WRITE !,$PIECE(X,U,1)

 +9        FOR I=2:1

               SET Y=$PIECE(X,U,I)

               IF Y=""

                   QUIT 

               WRITE !," ",Y

 +10      ;W !!,$P(^BGPELIIR(BGPPC,0),U,15)

 +11      ;I $P(^BGPELIIR(BGPPC,0),U,16)]"" W !?1,$P(^BGPELIIR(BGPPC,0),U,16)

 +12      ;I $P(^BGPELIIR(BGPPC,0),U,19)]"" W !?1,$P(^BGPELIIR(BGPPC,0),U,19)

 +13       DO H2

 +14       QUIT 

H2        ;EP

 +1        SET BGPX=""

           SET BGPX=$$C(BGPCYN,0,7)

           SET $EXTRACT(BGPX,9)=""

           SET $EXTRACT(BGPX,16)=$$C(BGPPRN,0,7)

           SET $EXTRACT(BGPX,24)=""

           SET $EXTRACT(BGPX,32)=$$CALC(BGPCYN,BGPPRN)

 +2        SET $EXTRACT(BGPX,39)=$$C(BGPBLN,0,7)

           SET $EXTRACT(BGPX,47)=""

           SET $EXTRACT(BGPX,54)=$$CALC(BGPCYN,BGPBLN)

 +3        WRITE ?20,BGPX

 +4        QUIT 

H1        ;EP

 +1        WRITE !!?21,"REPORT",?31,"",?35,"PREV YR",?46,"",?49,"CHG from",?59,"BASE",?69,"",?72,"CHG from"

 +2        WRITE !?21,"PERIOD      ",?35,"PERIOD      ",?49,"PREV YR ",?59,"PERIOD     ",?72,"BASE "

 +3        QUIT 

CALC(N,O) ;ENTRY POINT

 +1        NEW Z

 +2        SET Z=N-O

           SET Z=$FNUMBER(Z,"+,",0)

 +3        QUIT Z

C(X,X2,X3) ;

 +1        DO COMMA^%DTC

 +2        QUIT X