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

BGP3AU1A.m

Go to the documentation of this file. 
  1. BGP3AU1A ; IHS/CMI/LAB - BUILD CRS* FILES ;
  1.  ;;13.0;IHS CLINICAL REPORTING;**1**;NOV 20, 2012;Build 7
  1.  ;
  1. DESC ;----- ROUTINE DESCRIPTION
  1.  ;;
  1.  ;;This routine creates the 5 CRS* files from data uploaded
  1.  ;;from the sites contained in the BGP 11 DATA CURRENT, BGP
  1.  ;;11 DATA BASELINE and BGP 11 DATA PREVIOUS files.
  1.  ;;$$END 
  1.  N I,X F I=1:1 S X=$P($T(DESC+I),";;",2) Q:X["$$END"  D EN^DDIOL(X)
  1.  Q
  1.  ;
  1. EN(BGPBEGDT,BGPENDDT,BGPEND,BGPAUF) ;EP
  1.  ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  ;      INPUT:
  1.  ;      BGPBEGDT  =  BEGIN DATE OF BGP 11 DATA FILE ENTRIES
  1.  ;
  1.  N BGPPTYPE,BGPRTYPE,BGPBD,BGPED,BGPPBD,BGPPED,BGPBBD,BGPBED,BGPDELT
  1.  N BGPNODEL,BGPAREAA,BGPEXCEL,BGPRPT,BGPROT,BGPINDH,BGPUF,BGPSUL,BGPF
  1.  N BGPNOW,BGPASUF,X,BGPC
  1.  ;
  1.  D ^XBKVAR
  1.  D HOME^%ZIS
  1.  ;
  1.  ;SET SOME VARIABLES NEEDED BY THE BGP* ROUTINES:
  1.  S (BGPPTYPE,BGPRTYPE,BGPBD,BGPED,BGPIC,BGPPBD,BGPPED,BGPBBD,BGPBED,BGPDELT)=""
  1.  S BGPNODEL=1 ;USED IN BGP3PARP SO IT WON'T DO SAVEDEL^BGP3PDL
  1.  S BGPAREAA=1
  1.  S BGPEXCEL=1
  1.  S BGPRPT=0
  1.  S BGPROT="D"
  1.  S BGPINDH="G"
  1.  S BGPUF=$P($G(^BGPGP1PM(1,1)),U)
  1.  Q:BGPUF']""
  1.  ;
  1.  D SUL(BGPBEGDT,.BGPEND,.BGPSUL)
  1.  Q:'$D(BGPSUL)
  1.  S BGPC=0,X=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  S BGPC=BGPC+1
  1.  S BGPEND=BGPEND+17000000
  1.  ;
  1.  S BGPNOW=$$NOW^XLFDT()
  1.  S BGPNOW=$P(BGPNOW,".")_"."_$$RZERO^BGP3UTL($P(BGPNOW,".",2),6)
  1.  ;
  1.  S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
  1.  ;
  1.  S X=0 F  S X=$O(^BGPINDH("GPRA",1,X)) Q:X'=+X  S BGPIND(X)=""
  1.  ;
  1.  S X=".TXT"
  1.  S (BGPAUF(1),BGPFGNT1)="BGPGP"_BGPEND_"CRSGPRANT1"_X
  1.  S (BGPAUF(2),BGPFGNT2)="BGPGP"_BGPEND_"CRSGPRANT2"_X
  1.  S (BGPAUF(3),BGPFGNT2)="BGPGP"_BGPEND_"CRSGPRANT3"_X
  1.  S (BGPAUF(4),BGPFDEV1)="BGPGP"_BGPEND_"CRSGPRADEVNT1"_X
  1.  S (BGPAUF(5),BGPFDEV2)="BGPGP"_BGPEND_"CRSGPRADEVNT2"_X
  1.  S (BGPAUF(6),BGPFDEV3)="BGPGP"_BGPEND_"CRSGPRADEVNT3"_X
  1.  ;
  1.  S BGPAUEX=1
  1.  D SETEXCEL^BGP3DP
  1.  D PRINT^BGP3PARP
  1.  D GNT1^BGP3UTL
  1.  S X=".TXT"
  1.  ;now do it again with different filenames
  1.  K BGPEI,BGPEI2,BGPEIDV1,BGPEIDV2,BGPEIDV3,BGPONN1,BGPONN2,BGPONN3,BGPONN4,BGPONN5
  1.  S BGPFGNT1="CRSGPRANT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
  1.  S BGPFGNT2="CRSGPRANT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
  1.  S BGPFGNT3="CRSGPRANT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
  1.  S BGPFDEV1="CRSGPRADEVNT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
  1.  S BGPFDEV2="CRSGPRADEVNT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
  1.  S BGPFDEV3="CRSGPRADEVNT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
  1.  ;
  1.  S BGPAUEX=1
  1.  D SETEXCEL^BGP3DP
  1.  D PRINT^BGP3PARP
  1.  D GNT1^BGP3UTL
  1.  D KILL
  1.  Q
  1. SUL(BGPBEGDT,BGPEND,BGPSUL) ;
  1.  ;----- RETURNS BGPSUL ARRAY CONTAINING ENTRIES FROM 
  1.  ;      BGP 11 DATA FILE CONTAINING THE BEGINNING DATE
  1.  ;      
  1.  ;      INPUT:
  1.  ;      BGPBEGDT  =  BEGIN DATE
  1.  ;
  1.  N BGPD0
  1.  ;
  1.  S BGPD0=0
  1.  F  S BGPD0=$O(^BGPGPDCH("B",BGPBEGDT,BGPD0)) Q:'BGPD0  D
  1.  . S BGPSUL(BGPD0)=""
  1.  . S BGPEND=$P($G(^BGPGPDCH(BGPD0,0)),U,2)
  1.  Q
  1. KILL ;KILL VARIABLES SET BY BGP* ROUTINES
  1.  ;
  1.  K A,B,BGPA,BGPBLD,BGPBLN,BGPBLP,BGPC,BGPCHSN,BGPCHSO,BGPCYD
  1.  K BGPCYN,BGPCYP,BGPDAB,BGPDAC,BGPDAP,BGPDENP,BGPDF,BGPEC
  1.  K BGPGPG,BGPHD1,BGPHD2,BGPHPG,BGPIC,BGPIFTR,BGPIIDEL,BGPIND
  1.  K BGPIOSL,BGPLCNT,BGPNF,BGPNODE,BGPNP,BGPONN1,BGPONN2,BGPONN3
  1.  K BGPONN4,BGPORDP,BGPORDP1,BGPORDSE,BGPORXX,BGPP,BGPPC,BGPPC1
  1.  K BGPPC2,BGPPP1,BGPPRD,BGPPRN,BGPPRP,BGPQHDR,BGPQUIT,BGPSDPD
  1.  K BGPURBN,BGPURBO,BGPX,BGPX1,BGPXN,BGPXX,BGPXY,BGPY,BGPZ,C,D,E
  1.  K F,G,H,I,L,N,O,P,V,Y
  1.  Q