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

BGP3GR.m

Go to the documentation of this file.
BGP3GR ; IHS/CMI/LAB - BGPG Visual CRS Reports ;
 ;;13.0;IHS CLINICAL REPORTING;**1**;NOV 20, 2012;Build 7
 ;
NTL(RETVAL,BGPSTR) ;-- queue ngr
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPFN
 S P="|",R="~"
 S BGPI=0
 S BGPERR=""
 S BGPCT=$P($P(BGPSTR,P),R)
 I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
 S BGPYN=$P(BGPSTR,P,2)
 S BGPOT=$P(BGPSTR,P,3)
 S BGPOPT=$P(BGPSTR,P,4)
 S BGPOPT="CRS 13 NATIONAL GPRA REPORT"
 S BGPRT=$P(BGPSTR,P,5)
 S BGPMFITI=$P(BGPSTR,P,6)
 S BGPYWCHW=0  ;$P(BGPSTR,P,7)
 S BGPOM=$P(BGPSTR,P,8)
 S BGPFN=$P(BGPSTR,P,9)
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 D EP^BGP3GNTL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPFN)
 S BGPI=BGPI+1
 S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)
 D EN^XBVK("BGP")
 Q
 ;
NPL(RETVAL,BGPSTR) ;--queue nat lists
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL,BGPFN
 N BGPBLDT,BGPBEN
 S P="|",R="~"
 S BGPI=0
 S BGPERR=""
 I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
 S BGPCT=$P($P(BGPSTR,P),R)
 I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
 S BGPDT=$P(BGPSTR,P,2)
 S BGPPIEN=$P($P(BGPSTR,P,3),R)
 S BGPPRV=$P($P(BGPSTR,P,3),R,2)
 S BGPOPT="CRS 13 NATIONAL PATIENT LISTS"
 S BGPOT=$P(BGPSTR,P,4)
 S BGPRT=$P(BGPSTR,P,5)
 S BGPQTR=$P(BGPSTR,P,6)
 S BGPLST=$P(BGPSTR,P,7)
 S BGPMFITI=$P(BGPSTR,P,8)
 S BGPBLDT=$P(BGPSTR,P,9)
 S BGPBEN=$P(BGPSTR,P,10)
 S BGPFN=$P(BGPSTR,P,11)
 N I
 F I=13:1 D  Q:$P(BGPSTR,P,I)=""
 . Q:$P(BGPSTR,P,I)=""
 . N BGPNSTR
 . S BGPNSTR=$P(BGPSTR,P,I)
 . S BGPINDI=$P(BGPNSTR,R)
 . I $G(BGPINDI)["*" S BGPINDI=$P(BGPINDI,"*")  ;ihs/cmi/maw 3/30/2013 for new GUI v11.1
 . S BGPIND(BGPINDI)=""
 . N J
 . F J=2:1 D  Q:$P(BGPNSTR,R,J)=""
 .. Q:$P(BGPNSTR,R,J)=""
 .. N BGPSIND
 .. S BGPSIND=$P(BGPNSTR,R,J)
 .. I $G(BGPSIND)["*" S BGPSIND=$P(BGPSIND,"*")  ;ihs/cmi/maw 3/30/2013 for new GUI v11.1
 .. S BGPINDL(BGPINDI,BGPSIND)=""
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 D EP^BGP3GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN)
 S BGPI=BGPI+1
 S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)
 D EN^XBVK("BGP")
 Q
NPLS(RETVAL,BGPSTR) ;-- queue npl search template
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N BGPI,BGPJ,BGPDATA,BGPDA,P,B,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL,BGPSTMP,BGPFN
 N BGPBEN,BGPBASE,BGPSRCH
 S P="|",R="~",B="\"
 S BGPI=0
 S BGPERR=""
 I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
 S BGPCT=$P($P(BGPSTR,P),R)
 I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
 S BGPDT=$P(BGPSTR,P,2)
 S BGPPIEN=$P($P(BGPSTR,P,3),R)
 S BGPPRV=$P($P(BGPSTR,P,3),R,2)
 S BGPOPT="CRS 13 NATIONAL PATIENT LIST SEARCH TEMPLATE"
 S BGPOT=$P(BGPSTR,P,4)
 S BGPRT=$P(BGPSTR,P,5)
 S BGPQTR=$P(BGPSTR,P,6)
 S BGPLST=$P(BGPSTR,P,7)
 S BGPMFITI=$P(BGPSTR,P,8)
 S BGPBASE=$P(BGPSTR,P,9)
 S BGPBEN=$P(BGPSTR,P,10)
 S BGPFN=$P(BGPSTR,P,11)
 S BGPSTMP=$P(BGPSTR,B,2)
 S BGPSRCH=$P($P(BGPSTR,P,13),"&",2,9999)
 N I
 F I=13:1 D  Q:$P(BGPSTR,P,I)=""
 . Q:$P(BGPSTR,P,I)=""
 . N BGPNSTR
 . S BGPNSTR=$P(BGPSTR,P,I)
 . S BGPINDI=$P(BGPNSTR,R)
 . I $G(BGPINDI)["*" S BGPINDI=$P(BGPINDI,"*")  ;ihs/cmi/maw 3/30/2013 for new GUI v11.1
 . S BGPIND(BGPINDI)=""
 . N J
 . F J=2:1 D  Q:$P(BGPNSTR,R,J)=""
 .. Q:$P(BGPNSTR,R,J)=""
 .. Q:$P(BGPNSTR,R,J)["\"
 .. N BGPSIND
 .. S BGPSIND=$P(BGPNSTR,R,J)
 .. I $G(BGPSIND)["&" S BGPSIND=$P(BGPSIND,"&")
 .. Q:'$G(BGPSIND)
 .. I $G(BGPSIND)["*" S BGPSIND=$P(BGPSIND,"*")  ;ihs/cmi/maw 3/30/2013 for new GUI v11.1
 .. I $G(BGPSRCH)]"" S BGPSTMP=$P(BGPSRCH,"&",(J-1))  ;ihs/cmi/maw 3/30/2013 for new GUI v11.1
 .. S BGPINDL(BGPINDI,BGPSIND)=""
 .. S BGPINDL(BGPINDI,BGPSIND,"TEMP")=$G(BGPSTMP)
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 D EP^BGP3GNST(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBASE,BGPBEN,BGPFN)
 S BGPI=BGPI+1
 S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)
 D EN^XBVK("BGP")
 Q
COM(RETVAL,BGPSTR) ;sel measures by comm
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A
 N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPIND,BGPINDI,BGPLSTI
 S P="|",R="~",A="*"
 I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
 S BGPI=0
 S BGPERR=""
 S BGPCT=$P($P(BGPSTR,P),R)
 I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
 S BGPTP=$P(BGPSTR,P,2)
 S BGPQTR=$P(BGPSTR,P,3)
 S BGPRDT=$P(BGPSTR,P,4)
 S BGPRE=$P(BGPSTR,P,5)
 S BGPOPT="CRS 13 COM - SELECTED MEASURES REPORT"
 S BGPBAS=$P(BGPSTR,P,6)
 S BGPPATT=$P(BGPSTR,P,7)
 S BGPLIST=$P(BGPSTR,P,8)
 S BGPPRV=$P($P(BGPSTR,P,9),R)
 S BGPPROV=$P($P(BGPSTR,P,9),R,2)
 S BGPOT=$P(BGPSTR,P,10)
 S BGPFN=$P(BGPSTR,P,14)
 S BGPINDI=$P(BGPSTR,P,12)
 S BGPMFITI=$P(BGPSTR,P,13)
 S BGPLSTI=$P(BGPSTR,P,11)
 N I
 F I=2:1 D  Q:$P(BGPLSTI,A,I)=""
 . Q:$P(BGPLSTI,A,I)=""
 . N BGPL
 . S BGPL=$P($P(BGPLSTI,A,I),R)
 . S BGPLIST(BGPL)=""
 N J
 F J=2:1 D  Q:$P(BGPINDI,A,J)=""
 . Q:$P(BGPINDI,A,J)=""
 . N BGPL
 . S BGPL=$P($P(BGPINDI,A,J),R)
 . S BGPIND(BGPL)=""
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 D EP^BGP3GCOM(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN)
 S BGPI=BGPI+1
 S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)
 D EN^XBVK("BGP")
 Q
 ;
PP(RETVAL,BGPSTR) ;-- queue NGR
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPSEAT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN
 N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPSEAT,BGPIND,BGPINDH,BGPINDI,BGPLSTI
 S P="|",R="~",A="*"
 I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
 S BGPI=0
 S BGPERR=""
 S BGPTP=$P(BGPSTR,P,2)
 S BGPQTR=$P(BGPSTR,P,3)
 S BGPRDT=$P(BGPSTR,P,4)
 S BGPRE=$P(BGPSTR,P,5)
 S BGPOPT="CRS 13 PATIENT PANEL SELECTED MEASURES REPORT"
 S BGPBAS=$P(BGPSTR,P,6)
 S BGPSEAT=$P($P(BGPSTR,P,7),R)
 S BGPLIST=$P(BGPSTR,P,8)
 S BGPPRV=$P($P(BGPSTR,P,9),R)
 S BGPPROV=$P($P(BGPSTR,P,9),R,2)
 S BGPOT=$P(BGPSTR,P,10)
 S BGPINDI=$P(BGPSTR,P,12)
 S BGPLSTI=$P(BGPSTR,P,11)
 S BGPFN=$P(BGPSTR,P,13)
 N I
 F I=2:1 D  Q:$P(BGPLSTI,A,I)=""
 . Q:$P(BGPLSTI,A,I)=""
 . N BGPL
 . S BGPL=$P($P(BGPLSTI,A,I),R)
 . S BGPLIST(BGPL)=""
 N J
 F J=2:1 D  Q:$P(BGPINDI,A,J)=""
 . Q:$P(BGPINDI,A,J)=""
 . N BGPL
 . S BGPL=$P($P(BGPINDI,A,J),R)
 . S BGPIND(BGPL)=""
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 D EP^BGP3GPP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPSEAT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPFN)
 S BGPI=BGPI+1
 S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)
 D EN^XBVK("BGP")
 Q
 ;
ALL(RETVAL,BGPSTR) ;--selected with all comms
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A
 N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPIND,BGPINDH,BGPLSTI,BGPINDI,BGPFN
 S P="|",R="~",A="*"
 I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
 S BGPI=0
 S BGPERR=""
 S BGPTP=$P(BGPSTR,P,2)
 S BGPQTR=$P(BGPSTR,P,3)
 S BGPRDT=$P(BGPSTR,P,4)
 S BGPRE=$P(BGPSTR,P,5)
 S BGPOPT="CRS 13 ALL PATIENT SELECTED MEASURES REPORT"
 S BGPBAS=$P(BGPSTR,P,6)
 S BGPPATT=$P(BGPSTR,P,7)
 S BGPLIST=$P(BGPSTR,P,8)
 S BGPPRV=$P($P(BGPSTR,P,9),R)
 S BGPPROV=$P($P(BGPSTR,P,9),R,2)
 S BGPOT=$P(BGPSTR,P,10)
 S BGPINDI=$P(BGPSTR,P,12)
 S BGPLSTI=$P(BGPSTR,P,11)
 S BGPMFITI=$P(BGPSTR,P,13)
 S BGPFN=$P(BGPSTR,P,14)
 N I
 F I=2:1 D  Q:$P(BGPLSTI,A,I)=""
 . Q:$P(BGPLSTI,A,I)=""
 . N BGPL
 . S BGPL=$P($P(BGPLSTI,A,I),R)
 . S BGPLIST(BGPL)=""
 N J
 F J=2:1 D  Q:$P(BGPINDI,A,J)=""
 . Q:$P(BGPINDI,A,J)=""
 . N BGPL
 . S BGPL=$P($P(BGPINDI,A,J),R)
 . S BGPIND(BGPL)=""
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 D EP^BGP3GALL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN)
 S BGPI=BGPI+1
 S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)
 D EN^XBVK("BGP")
 Q
 ;
CMS(RETVAL,BGPSTR) ;
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPBEN,BGPEXPL
 N BGPEDT,BGPBDT,BGPFN
 S P="|",R="~"
 S BGPI=0
 S BGPERR=""
 I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
 S BGPCT=$P(BGPSTR,P)
 I $P(BGPCT,R)'?.N S BGPCT=$O(^DIC(4,"B",BGPCT,0))
 I $P(BGPCT,R)?.N S BGPCT=$P(BGPCT,R)
 S BGPDT=$P(BGPSTR,P,2)
 S BGPBDT=$P(BGPSTR,P,3)
 S BGPEDT=$P(BGPSTR,P,4)
 S BGPOPT="CRS 13 CMS PERFORMANCE REPORT"
 S BGPRT=$P(BGPSTR,P,7)
 S BGPQTR=$P(BGPSTR,P,5)
 S BGPBEN=$P(BGPSTR,P,6)
 S BGPEXPL=$P(BGPSTR,P,8)
 S BGPFN=$P(BGPSTR,P,9)
 N I
 F I=11:1 D  Q:$P(BGPSTR,P,I)=""
 . Q:$P(BGPSTR,P,I)=""
 . N BGPNSTR
 . S BGPNSTR=$P(BGPSTR,P,I)
 . S BGPINDI=$P(BGPNSTR,R)
 . S BGPIND(BGPINDI)=""
 . N J
 . F J=2:1 D  Q:$P(BGPNSTR,R,J)=""
 .. Q:$P(BGPNSTR,R,J)=""
 .. N BGPSIND
 .. S BGPSIND=$P(BGPNSTR,R,J)
 .. S BGPINDL(BGPINDI,BGPSIND)=""
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 D EP^BGP3GCMS(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPRT,BGPBDT,BGPEDT,BGPBEN,BGPEXPL,BGPFN)
 S BGPI=BGPI+1
 S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)
 D EN^XBVK("BGP")
 Q
GPU(RETVAL,BGPSTR) ;-- queue ngr
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPIND,BGPLIST
 N BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPINDI,R,BGPFN,BGPYNPAN,BGPPAN,BGPFP,BGPDESP
 S P="|",R="~"
 S BGPI=0
 S BGPERR=""
 S BGPCT=$P($P(BGPSTR,P),R)
 I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
 S BGPYN=$P(BGPSTR,P,2)
 S BGPQTR=$P(BGPSTR,P,3)
 S BGPRT=$P(BGPSTR,P,4)
 S BGPRE=$P(BGPSTR,P,5)
 S BGPBAS=$P(BGPSTR,P,6)
 S BGPBEN=$P(BGPSTR,P,7)
 S BGPOT=$P(BGPSTR,P,8)
 S BGPMFITI=$P(BGPSTR,P,9)
 S BGPFN=$P(BGPSTR,P,10)
 S BGPYNPAN=$P(BGPSTR,P,11)
 S BGPPAN=$P(BGPSTR,P,12)
 S BGPFP=$P(BGPSTR,P,13)
 S BGPDESP=$P(BGPSTR,P,14)
 S BGPOPT="CRS 13 GPU GPRA PERFORMANCE REPORT"
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 D EP^BGP3GGPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPFN,BGPYNPAN,BGPPAN,BGPFP,BGPDESP)
 S BGPI=BGPI+1
 S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)
 D EN^XBVK("BGP")
 Q
 ;
HED(RETVAL,BGPSTR) ;-- HEDIS Report
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A
 N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPYN,BGPIND,BGPLIST,BGPFN
 S P="|",R="~",A="*"
 I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
 S BGPI=0
 S BGPERR=""
 S BGPCT=$P($P(BGPSTR,P),R)
 I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
 S BGPYN=$P(BGPSTR,P,2)
 S BGPQTR=$P(BGPSTR,P,3)
 S BGPRDT=$P(BGPSTR,P,4)
 S BGPRE=$P(BGPSTR,P,5)
 S BGPOPT="CRS 13 HEDIS REPORT"
 S BGPBAS=$P(BGPSTR,P,6)
 S BGPPATT=$P(BGPSTR,P,7)
 S BGPLIST=$P(BGPSTR,P,8)
 S BGPPRV=$P($P(BGPSTR,P,9),R)
 S BGPPROV=$P($P(BGPSTR,P,9),R,2)
 S BGPOT=$P(BGPSTR,P,10)
 S BGPLSTI=$P(BGPSTR,P,11)
 S BGPMFITI=$P(BGPSTR,P,12)
 S BGPFN=$P(BGPSTR,P,13)
 N I
 F I=2:1 D  Q:$P(BGPLSTI,A,I)=""
 . Q:$P(BGPLSTI,A,I)=""
 . N BGPL
 . S BGPL=$P($P(BGPLSTI,A,I),R)
 . S BGPLIST(BGPL)=""
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 ;D EP^BGP3GHED(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPYN,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN)
 S BGPI=BGPI+1
 S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)
 D EN^XBVK("BGP")
 Q
 ;
LST(RETVAL,BGPSTR) ;-- list files
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPFN
 S P="|",R="~"
 S BGPI=0
 S BGPERR=""
 S BGPCT=$P($P(BGPSTR,P),R)
 I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
 S BGPYN=$P(BGPSTR,P,2)
 S BGPOT=$P(BGPSTR,P,3)
 S BGPOPT=$P(BGPSTR,P,4)
 S BGPRT=$P(BGPSTR,P,5)
 S BGPFN=$P(BGPSTR,P,6)
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 D EP^BGP3GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPFN)
 S BGPI=BGPI+1
 S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)
 D EN^XBVK("BGP")
 Q
 ;
NPLST(RETVAL,BGPSTR) ;-- list files
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPFN
 S P="|",R="~"
 S BGPI=0
 S BGPERR=""
 S BGPCT=$P($P(BGPSTR,P),R)
 I $P(BGPCT,R)'?.N S BGPCT=$O(^ATXAX("B",BGPCT,0))
 S BGPYN=$P(BGPSTR,P,2)
 S BGPOT=$P(BGPSTR,P,3)
 S BGPOPT=$P(BGPSTR,P,4)
 S BGPRT=$P(BGPSTR,P,5)
 S BGPMFITI=$P(BGPSTR,P,6)
 S BGPFN=$P(BGPSTR,P,7)
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 D EP^BGP3GNST(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPFN)
 S BGPI=BGPI+1
 S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)
 D EN^XBVK("BGP")
 Q
ELD(RETVAL,BGPSTR) ;
 G ELD^BGP3GR1
ONTL(RETVAL,BGPSTR) ;
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N P,BGPI,BGPDA,BGPRIEN,BGPNOD
 S P="|"
 S BGPRIEN=$P(BGPSTR,P)
 S BGPNOD=11
 I $P($G(^BGPGUIH(BGPRIEN,0)),U,7)="X" S BGPNOD=12
 S RETVAL="^BGPTMP("_$J_")"
 S BGPI=0
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 S BGPDA=0 F  S BGPDA=$O(^BGPGUIH(BGPRIEN,BGPNOD,BGPDA)) Q:'BGPDA  D
 . S BGPI=BGPI+1
 . S ^BGPTMP($J,BGPI)=$G(^BGPGUIH(BGPRIEN,BGPNOD,BGPDA,0))_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)_$G(X)
 D EN^XBVK("BGP")
 Q
 ;
DNTL(RETVAL,BGPSTR) ;
 S X="MERR^BGP3GU",@^%ZOSF("TRAP")
 N P,BGPI,BGPDA,BGPRIEN
 S P="|"
 S BGPRIEN=$P(BGPSTR,P)
 S RETVAL="^BGPTMP("_$J_")"
 S BGPI=0
 S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
 S BGPDA=0 F  S BGPDA=$O(^BGPGUIH(BGPRIEN,12,BGPDA)) Q:'BGPDA  D
 . S BGPI=BGPI+1
 . S ^BGPTMP($J,BGPI)=$TR($G(^BGPGUIH(BGPRIEN,12,BGPDA,0)),"^","~")_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
 D EN^XBVK("BGP")
 Q
 ;
CATSTR(BGPSRET,STR) ;EP
 N BGPDA
 S BGPSRET=""
 S BGPDA=0 F  S BGPDA=$O(STR(BGPDA)) Q:'BGPDA  D
 . S BGPSRET=BGPSRET_$G(STR(BGPDA))
 Q
 ;