BGP9EL1L.m

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

 ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 ;

 ;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(^BGPELIIN("AP",BGPPC1,BGPPC)) Q:BGPPC=""  D PI1

 Q

PI1 ;

 K BGPCYP,BGPBLP,BGPPRD,BGPEXCT,BGPSDP

 S (BGPCYD,BGPPRD,BGPBLD)=""

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

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

 D SETN^BGP9ELP1

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

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

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

 I $P(^BGPELIIN(BGPPC,0),U,19)]"" W !?1,$P(^BGPELIIN(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

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

 +1       ;;9.0;IHS CLINICAL REPORTING;;JUL 1, 2009

 +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(^BGPELIIN("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(^BGPELIIN(BGPPC,0),U,9)

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

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

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

 +5        DO SETN^BGP9ELP1

 +6        IF $Y>(BGPIOSL-6)

               DO HEADER^BGP9DPH

               IF BGPQUIT

                   QUIT 

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

               DO H1

 +7        WRITE !!,$PIECE(^BGPELIIN(BGPPC,0),U,15)

 +8        IF $PIECE(^BGPELIIN(BGPPC,0),U,16)]""

               WRITE !?1,$PIECE(^BGPELIIN(BGPPC,0),U,16)

 +9        IF $PIECE(^BGPELIIN(BGPPC,0),U,19)]""

               WRITE !?1,$PIECE(^BGPELIIN(BGPPC,0),U,19)

 +10       DO H2

 +11       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