- BGP4EL1L ; IHS/CMI/LAB - print ind 1 ;
- ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
- ;
- ;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(^BGPELIIJ("AP",BGPPC1,BGPPC)) Q:BGPPC="" D PI1
- Q
- PI1 ;
- K BGPCYP,BGPBLP,BGPPRD,BGPEXCT,BGPSDP
- S (BGPCYD,BGPPRD,BGPBLD)=""
- S BGPNF=$P(^BGPELIIJ(BGPPC,0),U,9)
- S BGPNP=$P(^DD(90553.03,BGPNF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
- D SETN^BGP4ELP1
- I $Y>(BGPIOSL-6) D HEADER^BGP4DPH Q:BGPQUIT W !!,^BGPELIJ(BGPIC,53,1,0) D H1
- W !!,$P(^BGPELIIJ(BGPPC,0),U,15)
- I $P(^BGPELIIJ(BGPPC,0),U,16)]"" W !?1,$P(^BGPELIIJ(BGPPC,0),U,16)
- I $P(^BGPELIIJ(BGPPC,0),U,19)]"" W !?1,$P(^BGPELIIJ(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
- BGP4EL1L ; IHS/CMI/LAB - print ind 1 ;
- +1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
- +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(^BGPELIIJ("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(^BGPELIIJ(BGPPC,0),U,9)
- +4 SET BGPNP=$PIECE(^DD(90553.03,BGPNF,0),U,4)
- SET N=$PIECE(BGPNP,";")
- SET P=$PIECE(BGPNP,";",2)
- +5 DO SETN^BGP4ELP1
- +6 IF $Y>(BGPIOSL-6)
- DO HEADER^BGP4DPH
- IF BGPQUIT
- QUIT
- WRITE !!,^BGPELIJ(BGPIC,53,1,0)
- DO H1
- +7 WRITE !!,$PIECE(^BGPELIIJ(BGPPC,0),U,15)
- +8 IF $PIECE(^BGPELIIJ(BGPPC,0),U,16)]""
- WRITE !?1,$PIECE(^BGPELIIJ(BGPPC,0),U,16)
- +9 IF $PIECE(^BGPELIIJ(BGPPC,0),U,19)]""
- WRITE !?1,$PIECE(^BGPELIIJ(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