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

BGP8PCUT.m

Go to the documentation of this file. 
  1. BGP8PCUT ; IHS/CMI/LAB - ;
  1.  ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
  1.  ;
  1.  ;
  1.  ;utility calls
  1.  ;
  1. STMP ;EP
  1.  Q:BGPTIME'=1
  1.  I BGPLIST="P",$P(^AUPNPAT(DFN,0),U,14)'=BGPLPRV Q
  1.  X ^BGPIPCMR(BGPIC,2) Q:'$T
  1.  S BGPLIST(BGPIC)=$G(BGPLIST(BGPIC))+1
  1.  S ^XTMP("BGP8D",BGPJ,BGPH,"LIST",BGPIC,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEB,DFN)=BGPVALUE
  1.  Q
  1. D(D) ;EP
  1.  I D="" Q ""
  1.  Q (1700+$E(D,1,3))_$E(D,4,5)_$E(D,6,7)_$S($P(D,".",2)]"":$P(D,".",2),1:"")
  1. JRNL ;EP
  1.  N (DT,U,ZTQUEUED) S %=$$NOJOURN^ZIBGCHAR("BGPGPDCR"),%=$$NOJOURN^ZIBGCHAR("BGPGPDPR"),%=$$NOJOURN^ZIBGCHAR("BGPGPDBR")
  1.  Q
  1. DATE(D) ;EP
  1.  I D="" Q ""
  1.  Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
  1.  ;
  1. REPORT ;EP - CREATE REPORT ENTRIES IN DATA FILES
  1.  S BGPRPT=""
  1.  W !!
  1.  ;CREATE REPORT ENTRY IN FILEMAN FILE
  1.  ;3 files must have the same ien
  1.  L +^BGPGPDCR:30 I '$T W !!,"Unable to lock global, try later." G REPORTX
  1.  L +^BGPGPDPR:30 I '$T W !!,"Unable to lock global, try later." G REPORTX
  1.  L +^BGPGPDBR:30 I '$T W !!,"Unable to lock global, try later." G REPORTX
  1.  D GETIEN
  1.  I 'BGPIEN W !!,"Something wrong with control files, notify programmer!" S BGPRPT="" G REPORTX
  1.  S DINUM=BGPIEN
  1.  K DIC S X=BGPBD,DIC(0)="L",DIC="^BGPGPDCR(",DLAYGO=90561.09,DIADD=1,DIC("DR")=".02////"_BGPED_";.03////"_BGPPBD_";.04////"_BGPPED_";.05////"_BGPBBD_";.06////"_BGPBED_";.07////"_$G(BGPPER)_";.08////"_$G(BGPQTR)
  1.  S DIC("DR")=DIC("DR")_";.09////"_$P(^AUTTLOC(DUZ(2),0),U,10)_";.11////"_$E($P(^AUTTLOC(DUZ(2),0),U,10),1,4)_";.12////"_BGPRTYPE_";.13////"_DT_";.14////"_BGPBEN_";.15////"_$P($G(^AUTTLOC(DUZ(2),1)),U,3)
  1.  S DIC("DR")=DIC("DR")_";.17///"_$P(^BGPSITE(DUZ(2),0),U,6)_";.18///"_$S($G(BGPTAXI):$P(^ATXAX(BGPTAXI,0),U),1:"")_";.19///"_$P(^BGPSITE(DUZ(2),0),U,13)
  1.  D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S BGPQUIT=1 G REPORTX
  1.  S BGPRPT=+Y
  1.  K DIC S X=BGPBD,DIC(0)="L",DIC="^BGPGPDPR(",DLAYGO=90561.1,DIADD=1,DIC("DR")=".02////"_BGPED_";.03////"_BGPPBD_";.04////"_BGPPED_";.05////"_BGPBBD_";.06////"_BGPBED_";.07////"_$G(BGPPER)_";.08////"_$G(BGPQTR)
  1.  S DIC("DR")=DIC("DR")_";.09////"_$P(^AUTTLOC(DUZ(2),0),U,10)_";.11////"_$E($P(^AUTTLOC(DUZ(2),0),U,10),1,4)_";.12////"_BGPRTYPE_";.13////"_DT_";.14////"_BGPBEN_";.15////"_$P($G(^AUTTLOC(DUZ(2),1)),U,3)
  1.  S DIC("DR")=DIC("DR")_";.17///"_$P(^BGPSITE(DUZ(2),0),U,6)_";.18///"_$S($G(BGPTAXI):$P(^ATXAX(BGPTAXI,0),U),1:"")_";.19///"_$P(^BGPSITE(DUZ(2),0),U,13)
  1.  S DINUM=BGPRPT D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DINUM I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S BGPQUIT=1 G REPORTX
  1.  S BGPRPTP=+Y
  1.  K DIC S X=BGPBD,DIC(0)="L",DIC="^BGPGPDBR(",DLAYGO=90561.11,DIADD=1,DIC("DR")=".02////"_BGPED_";.03////"_BGPPBD_";.04////"_BGPPED_";.05////"_BGPBBD_";.06////"_BGPBED_";.07////"_$G(BGPPER)_";.08////"_$G(BGPQTR)
  1.  S DIC("DR")=DIC("DR")_";.09////"_$P(^AUTTLOC(DUZ(2),0),U,10)_";.11////"_$E($P(^AUTTLOC(DUZ(2),0),U,10),1,4)_";.12////"_BGPRTYPE_";.13////"_DT_";.14////"_BGPBEN_";.15////"_$P($G(^AUTTLOC(DUZ(2),1)),U,3)
  1.  S DIC("DR")=DIC("DR")_";.17///"_$P(^BGPSITE(DUZ(2),0),U,6)_";.18///"_$S($G(BGPTAXI):$P(^ATXAX(BGPTAXI,0),U),1:"")_";.19///"_$P(^BGPSITE(DUZ(2),0),U,13)
  1.  S DINUM=BGPRPT D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S BGPQUIT=1 G REPORTX
  1.  S BGPRPTB=+Y
  1.  ;add communities to 28 multiple
  1.  K ^BGPGPDCR(BGPRPT,9999)
  1.  S C=0,X="" F  S X=$O(BGPTAX(X)) Q:X=""  S C=C+1 S ^BGPGPDCR(BGPRPT,9999,C,0)=X,^BGPGPDCR(BGPRPT,9999,"B",X,C)=""
  1.  S ^BGPGPDCR(BGPRPT,9999,0)="^90561.18999A^"_C_"^"_C
  1.  S ^BGPGPDCR(BGPRPT,1111,0)="^90561.091111^"_C_"^"_C
  1.  S ^BGPGPDCR(BGPRPT,99999,0)="^90561.189999A^0^0"
  1.  S ^BGPGPDPR(BGPRPT,99999,0)="^90561.139999A^0^0"
  1.  S ^BGPGPDBR(BGPRPT,99999,0)="^90561.149999A^0^0"
  1. REPORTX ;
  1.  D ^XBFMK
  1.  K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
  1.  L -^BGPGPDCR
  1.  L -^BGPGPDPR
  1.  L -^BGPGPDBR
  1.  Q
  1. GETIEN ;EP -Get next ien available in all 3 files
  1.  S BGPF=90561.09 D ENT
  1.  S BGPF=90561.1 D ENT
  1.  S BGPF=90561.11 D ENT
  1.  S BGPIEN=$P(^BGPGPDCR(0),U,3)+1
  1. S I $D(^BGPGPDPR(BGPIEN))!($D(^BGPGPDBR(BGPIEN))) S BGPIEN=BGPIEN+1 G S
  1.  Q
  1.  ;
  1. ENT ;
  1.  NEW GBL,NXT,CTR,XBHI,XBX,XBY,ANS
  1.  S GBL=^DIC(BGPF,0,"GL")
  1.  S GBL=GBL_"NXT)"
  1.  S (XBHI,NXT,CTR)=0
  1.  F L=0:0 S NXT=$O(@(GBL)) Q:NXT'=+NXT  S XBHI=NXT,CTR=CTR+1 ;W:'(CTR#50) "."
  1.  S NXT="",XBX=$O(@(GBL)),XBX=^(0),XBY=$P(XBX,U,4),XBX=$P(XBX,U,3)
  1.  S NXT=0,$P(@(GBL),U,3)=XBHI,$P(^(0),U,4)=CTR
  1.  ;
  1. EOJ ;
  1.  KILL ANS,XBHI,XBX,XBY,CTR,DIC,FILE,GBL,L,NXT,BGPF
  1.  Q
  1.  ;