Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP4EL1L

BGP4EL1L.m

Go to the documentation of this file.
  1. BGP4EL1L ; IHS/CMI/LAB - print ind 1 ;
  1. ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
  1. ;
  1. ;PUBLIC HEALTH NURSING
  1. IELDPHA ;EP
  1. D H1
  1. F BGPPC1="24.1","24.2" Q:BGPQUIT W ! D PI
  1. Q
  1. PI ;EP
  1. S BGPPC=0 F S BGPPC=$O(^BGPELIIJ("AP",BGPPC1,BGPPC)) Q:BGPPC="" D PI1
  1. Q
  1. PI1 ;
  1. K BGPCYP,BGPBLP,BGPPRD,BGPEXCT,BGPSDP
  1. S (BGPCYD,BGPPRD,BGPBLD)=""
  1. S BGPNF=$P(^BGPELIIJ(BGPPC,0),U,9)
  1. S BGPNP=$P(^DD(90553.03,BGPNF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
  1. D SETN^BGP4ELP1
  1. I $Y>(BGPIOSL-6) D HEADER^BGP4DPH Q:BGPQUIT W !!,^BGPELIJ(BGPIC,53,1,0) D H1
  1. W !!,$P(^BGPELIIJ(BGPPC,0),U,15)
  1. I $P(^BGPELIIJ(BGPPC,0),U,16)]"" W !?1,$P(^BGPELIIJ(BGPPC,0),U,16)
  1. I $P(^BGPELIIJ(BGPPC,0),U,19)]"" W !?1,$P(^BGPELIIJ(BGPPC,0),U,19)
  1. D H2
  1. Q
  1. H2 ;EP
  1. 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)
  1. S $E(BGPX,39)=$$C(BGPBLN,0,7),$E(BGPX,47)="",$E(BGPX,54)=$$CALC(BGPCYN,BGPBLN)
  1. W ?20,BGPX
  1. Q
  1. H1 ;EP
  1. W !!?21,"REPORT",?31,"",?35,"PREV YR",?46,"",?49,"CHG from",?59,"BASE",?69,"",?72,"CHG from"
  1. W !?21,"PERIOD ",?35,"PERIOD ",?49,"PREV YR ",?59,"PERIOD ",?72,"BASE "
  1. Q
  1. CALC(N,O) ;ENTRY POINT
  1. NEW Z
  1. S Z=N-O,Z=$FN(Z,"+,",0)
  1. Q Z
  1. C(X,X2,X3) ;
  1. D COMMA^%DTC
  1. Q X