BGP3AU1A ; IHS/CMI/LAB - BUILD CRS* FILES ;
;;13.0;IHS CLINICAL REPORTING;**1**;NOV 20, 2012;Build 7
;
DESC ;----- ROUTINE DESCRIPTION
;;
;;This routine creates the 5 CRS* files from data uploaded
;;from the sites contained in the BGP 11 DATA CURRENT, BGP
;;11 DATA BASELINE and BGP 11 DATA PREVIOUS files.
;;$$END
N I,X F I=1:1 S X=$P($T(DESC+I),";;",2) Q:X["$$END" D EN^DDIOL(X)
Q
;
EN(BGPBEGDT,BGPENDDT,BGPEND,BGPAUF) ;EP
;EP -- MAIN ENTRY POINT
;
; INPUT:
; BGPBEGDT = BEGIN DATE OF BGP 11 DATA FILE ENTRIES
;
N BGPPTYPE,BGPRTYPE,BGPBD,BGPED,BGPPBD,BGPPED,BGPBBD,BGPBED,BGPDELT
N BGPNODEL,BGPAREAA,BGPEXCEL,BGPRPT,BGPROT,BGPINDH,BGPUF,BGPSUL,BGPF
N BGPNOW,BGPASUF,X,BGPC
;
D ^XBKVAR
D HOME^%ZIS
;
;SET SOME VARIABLES NEEDED BY THE BGP* ROUTINES:
S (BGPPTYPE,BGPRTYPE,BGPBD,BGPED,BGPIC,BGPPBD,BGPPED,BGPBBD,BGPBED,BGPDELT)=""
S BGPNODEL=1 ;USED IN BGP3PARP SO IT WON'T DO SAVEDEL^BGP3PDL
S BGPAREAA=1
S BGPEXCEL=1
S BGPRPT=0
S BGPROT="D"
S BGPINDH="G"
S BGPUF=$P($G(^BGPGP1PM(1,1)),U)
Q:BGPUF']""
;
D SUL(BGPBEGDT,.BGPEND,.BGPSUL)
Q:'$D(BGPSUL)
S BGPC=0,X=0 F S X=$O(BGPSUL(X)) Q:X'=+X S BGPC=BGPC+1
S BGPEND=BGPEND+17000000
;
S BGPNOW=$$NOW^XLFDT()
S BGPNOW=$P(BGPNOW,".")_"."_$$RZERO^BGP3UTL($P(BGPNOW,".",2),6)
;
S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
;
S X=0 F S X=$O(^BGPINDH("GPRA",1,X)) Q:X'=+X S BGPIND(X)=""
;
S X=".TXT"
S (BGPAUF(1),BGPFGNT1)="BGPGP"_BGPEND_"CRSGPRANT1"_X
S (BGPAUF(2),BGPFGNT2)="BGPGP"_BGPEND_"CRSGPRANT2"_X
S (BGPAUF(3),BGPFGNT2)="BGPGP"_BGPEND_"CRSGPRANT3"_X
S (BGPAUF(4),BGPFDEV1)="BGPGP"_BGPEND_"CRSGPRADEVNT1"_X
S (BGPAUF(5),BGPFDEV2)="BGPGP"_BGPEND_"CRSGPRADEVNT2"_X
S (BGPAUF(6),BGPFDEV3)="BGPGP"_BGPEND_"CRSGPRADEVNT3"_X
;
S BGPAUEX=1
D SETEXCEL^BGP3DP
D PRINT^BGP3PARP
D GNT1^BGP3UTL
S X=".TXT"
;now do it again with different filenames
K BGPEI,BGPEI2,BGPEIDV1,BGPEIDV2,BGPEIDV3,BGPONN1,BGPONN2,BGPONN3,BGPONN4,BGPONN5
S BGPFGNT1="CRSGPRANT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
S BGPFGNT2="CRSGPRANT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
S BGPFGNT3="CRSGPRANT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
S BGPFDEV1="CRSGPRADEVNT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
S BGPFDEV2="CRSGPRADEVNT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
S BGPFDEV3="CRSGPRADEVNT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
;
S BGPAUEX=1
D SETEXCEL^BGP3DP
D PRINT^BGP3PARP
D GNT1^BGP3UTL
D KILL
Q
SUL(BGPBEGDT,BGPEND,BGPSUL) ;
;----- RETURNS BGPSUL ARRAY CONTAINING ENTRIES FROM
; BGP 11 DATA FILE CONTAINING THE BEGINNING DATE
;
; INPUT:
; BGPBEGDT = BEGIN DATE
;
N BGPD0
;
S BGPD0=0
F S BGPD0=$O(^BGPGPDCH("B",BGPBEGDT,BGPD0)) Q:'BGPD0 D
. S BGPSUL(BGPD0)=""
. S BGPEND=$P($G(^BGPGPDCH(BGPD0,0)),U,2)
Q
KILL ;KILL VARIABLES SET BY BGP* ROUTINES
;
K A,B,BGPA,BGPBLD,BGPBLN,BGPBLP,BGPC,BGPCHSN,BGPCHSO,BGPCYD
K BGPCYN,BGPCYP,BGPDAB,BGPDAC,BGPDAP,BGPDENP,BGPDF,BGPEC
K BGPGPG,BGPHD1,BGPHD2,BGPHPG,BGPIC,BGPIFTR,BGPIIDEL,BGPIND
K BGPIOSL,BGPLCNT,BGPNF,BGPNODE,BGPNP,BGPONN1,BGPONN2,BGPONN3
K BGPONN4,BGPORDP,BGPORDP1,BGPORDSE,BGPORXX,BGPP,BGPPC,BGPPC1
K BGPPC2,BGPPP1,BGPPRD,BGPPRN,BGPPRP,BGPQHDR,BGPQUIT,BGPSDPD
K BGPURBN,BGPURBO,BGPX,BGPX1,BGPXN,BGPXX,BGPXY,BGPY,BGPZ,C,D,E
K F,G,H,I,L,N,O,P,V,Y
Q
BGP3AU1A ; IHS/CMI/LAB - BUILD CRS* FILES ;
+1 ;;13.0;IHS CLINICAL REPORTING;**1**;NOV 20, 2012;Build 7
+2 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;;This routine creates the 5 CRS* files from data uploaded
+3 ;;from the sites contained in the BGP 11 DATA CURRENT, BGP
+4 ;;11 DATA BASELINE and BGP 11 DATA PREVIOUS files.
+5 ;;$$END
+6 NEW I,X
FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";;",2)
IF X["$$END"
QUIT
DO EN^DDIOL(X)
+7 QUIT
+8 ;
EN(BGPBEGDT,BGPENDDT,BGPEND,BGPAUF) ;EP
+1 ;EP -- MAIN ENTRY POINT
+2 ;
+3 ; INPUT:
+4 ; BGPBEGDT = BEGIN DATE OF BGP 11 DATA FILE ENTRIES
+5 ;
+6 NEW BGPPTYPE,BGPRTYPE,BGPBD,BGPED,BGPPBD,BGPPED,BGPBBD,BGPBED,BGPDELT
+7 NEW BGPNODEL,BGPAREAA,BGPEXCEL,BGPRPT,BGPROT,BGPINDH,BGPUF,BGPSUL,BGPF
+8 NEW BGPNOW,BGPASUF,X,BGPC
+9 ;
+10 DO ^XBKVAR
+11 DO HOME^%ZIS
+12 ;
+13 ;SET SOME VARIABLES NEEDED BY THE BGP* ROUTINES:
+14 SET (BGPPTYPE,BGPRTYPE,BGPBD,BGPED,BGPIC,BGPPBD,BGPPED,BGPBBD,BGPBED,BGPDELT)=""
+15 ;USED IN BGP3PARP SO IT WON'T DO SAVEDEL^BGP3PDL
SET BGPNODEL=1
+16 SET BGPAREAA=1
+17 SET BGPEXCEL=1
+18 SET BGPRPT=0
+19 SET BGPROT="D"
+20 SET BGPINDH="G"
+21 SET BGPUF=$PIECE($GET(^BGPGP1PM(1,1)),U)
+22 IF BGPUF']""
QUIT
+23 ;
+24 DO SUL(BGPBEGDT,.BGPEND,.BGPSUL)
+25 IF '$DATA(BGPSUL)
QUIT
+26 SET BGPC=0
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
SET BGPC=BGPC+1
+27 SET BGPEND=BGPEND+17000000
+28 ;
+29 SET BGPNOW=$$NOW^XLFDT()
+30 SET BGPNOW=$PIECE(BGPNOW,".")_"."_$$RZERO^BGP3UTL($PIECE(BGPNOW,".",2),6)
+31 ;
+32 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+33 ;
+34 SET X=0
FOR
SET X=$ORDER(^BGPINDH("GPRA",1,X))
IF X'=+X
QUIT
SET BGPIND(X)=""
+35 ;
+36 SET X=".TXT"
+37 SET (BGPAUF(1),BGPFGNT1)="BGPGP"_BGPEND_"CRSGPRANT1"_X
+38 SET (BGPAUF(2),BGPFGNT2)="BGPGP"_BGPEND_"CRSGPRANT2"_X
+39 SET (BGPAUF(3),BGPFGNT2)="BGPGP"_BGPEND_"CRSGPRANT3"_X
+40 SET (BGPAUF(4),BGPFDEV1)="BGPGP"_BGPEND_"CRSGPRADEVNT1"_X
+41 SET (BGPAUF(5),BGPFDEV2)="BGPGP"_BGPEND_"CRSGPRADEVNT2"_X
+42 SET (BGPAUF(6),BGPFDEV3)="BGPGP"_BGPEND_"CRSGPRADEVNT3"_X
+43 ;
+44 SET BGPAUEX=1
+45 DO SETEXCEL^BGP3DP
+46 DO PRINT^BGP3PARP
+47 DO GNT1^BGP3UTL
+48 SET X=".TXT"
+49 ;now do it again with different filenames
+50 KILL BGPEI,BGPEI2,BGPEIDV1,BGPEIDV2,BGPEIDV3,BGPONN1,BGPONN2,BGPONN3,BGPONN4,BGPONN5
+51 SET BGPFGNT1="CRSGPRANT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
+52 SET BGPFGNT2="CRSGPRANT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
+53 SET BGPFGNT3="CRSGPRANT3"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
+54 SET BGPFDEV1="CRSGPRADEVNT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
+55 SET BGPFDEV2="CRSGPRADEVNT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
+56 SET BGPFDEV3="CRSGPRADEVNT3"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_BGPEND_$$D^BGP3UTL(BGPNOW)_"_"_$$LZERO^BGP3UTL(BGPC,6)_".TXT"
+57 ;
+58 SET BGPAUEX=1
+59 DO SETEXCEL^BGP3DP
+60 DO PRINT^BGP3PARP
+61 DO GNT1^BGP3UTL
+62 DO KILL
+63 QUIT
SUL(BGPBEGDT,BGPEND,BGPSUL) ;
+1 ;----- RETURNS BGPSUL ARRAY CONTAINING ENTRIES FROM
+2 ; BGP 11 DATA FILE CONTAINING THE BEGINNING DATE
+3 ;
+4 ; INPUT:
+5 ; BGPBEGDT = BEGIN DATE
+6 ;
+7 NEW BGPD0
+8 ;
+9 SET BGPD0=0
+10 FOR
SET BGPD0=$ORDER(^BGPGPDCH("B",BGPBEGDT,BGPD0))
IF 'BGPD0
QUIT
Begin DoDot:1
+11 SET BGPSUL(BGPD0)=""
+12 SET BGPEND=$PIECE($GET(^BGPGPDCH(BGPD0,0)),U,2)
End DoDot:1
+13 QUIT
KILL ;KILL VARIABLES SET BY BGP* ROUTINES
+1 ;
+2 KILL A,B,BGPA,BGPBLD,BGPBLN,BGPBLP,BGPC,BGPCHSN,BGPCHSO,BGPCYD
+3 KILL BGPCYN,BGPCYP,BGPDAB,BGPDAC,BGPDAP,BGPDENP,BGPDF,BGPEC
+4 KILL BGPGPG,BGPHD1,BGPHD2,BGPHPG,BGPIC,BGPIFTR,BGPIIDEL,BGPIND
+5 KILL BGPIOSL,BGPLCNT,BGPNF,BGPNODE,BGPNP,BGPONN1,BGPONN2,BGPONN3
+6 KILL BGPONN4,BGPORDP,BGPORDP1,BGPORDSE,BGPORXX,BGPP,BGPPC,BGPPC1
+7 KILL BGPPC2,BGPPP1,BGPPRD,BGPPRN,BGPPRP,BGPQHDR,BGPQUIT,BGPSDPD
+8 KILL BGPURBN,BGPURBO,BGPX,BGPX1,BGPXN,BGPXX,BGPXY,BGPY,BGPZ,C,D,E
+9 KILL F,G,H,I,L,N,O,P,V,Y
+10 QUIT
