- BGP8GR ; IHS/CMI/LAB - BGPG Visual CRS Reports ;
- ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
- ;
- NTL(RETVAL,BGPSTR) ;-- queue ngr
- S X="MERR^BGP8GU",@^%ZOSF("TRAP")
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPFN,BGPLOG
- 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 18 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)
- S BGPLOG=$P(BGPSTR,P,10)
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP8GNTL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPFN,BGPLOG)
- 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^BGP8GU",@^%ZOSF("TRAP")
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL,BGPFN,BGPLOG
- 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 18 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)
- S BGPLOG=$P(BGPSTR,P,12)
- 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,"*")
- . 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,"*")
- .. S BGPINDL(BGPINDI,BGPSIND)=""
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP8GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN,BGPLOG)
- 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^BGP8GU",@^%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 18 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,"*")
- . 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,"*")
- .. I $G(BGPSRCH)]"" S BGPSTMP=$P(BGPSRCH,"&",(J-1)) ;ihs/cmi/maw 3/30/2014 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^BGP8GNST(.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^BGP8GU",@^%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,BGPLOG
- N BGPCOMM
- 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 18 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)
- S BGPLOG=$P(BGPSTR,P,15)
- S BGPCOMM=$P(BGPSTR,P,16)
- 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^BGP8GCOM(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN,BGPLOG,BGPCOMM)
- 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^BGP8GU",@^%ZOSF("TRAP")
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPSEAT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN,BGPLOG
- N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPSEAT,BGPIND,BGPINDG,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 18 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)
- S BGPLOG=$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^BGP8GPP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPSEAT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPFN,BGPLOG)
- 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^BGP8GU",@^%ZOSF("TRAP")
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPLOG
- N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPIND,BGPINDG,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 18 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)
- S BGPLOG=$P(BGPSTR,P,15)
- 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^BGP8GALL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN,BGPLOG)
- 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^BGP8GU",@^%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 18 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^BGP8GCMS(.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^BGP8GU",@^%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,BGPLOG
- N BGPCOMM
- 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 BGPLOG=$P(BGPSTR,P,15)
- S BGPCOMM=$P(BGPSTR,P,16)
- S BGPOPT="CRS 18 GPU GPRA PERFORMANCE REPORT"
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP8GGPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPFN,BGPYNPAN,BGPPAN,BGPFP,BGPDESP,BGPLOG,BGPCOMM)
- 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^BGP8GU",@^%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 18 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^BGP8GHED(.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^BGP8GU",@^%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^BGP8GNPL(.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^BGP8GU",@^%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^BGP8GNST(.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^BGP8GR1
- ONTL(RETVAL,BGPSTR) ;
- S X="MERR^BGP8GU",@^%ZOSF("TRAP")
- N P,BGPI,BGPDA,BGPRIEN,BGPNOD
- S P="|"
- S BGPRIEN=$P(BGPSTR,P)
- S BGPNOD=11
- I $P($G(^BGPGUIR(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(^BGPGUIR(BGPRIEN,BGPNOD,BGPDA)) Q:'BGPDA D
- . S BGPI=BGPI+1
- . S ^BGPTMP($J,BGPI)=$G(^BGPGUIR(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^BGP8GU",@^%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(^BGPGUIR(BGPRIEN,12,BGPDA)) Q:'BGPDA D
- . S BGPI=BGPI+1
- . S ^BGPTMP($J,BGPI)=$TR($G(^BGPGUIR(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
- ;
- BGP8GR ; IHS/CMI/LAB - BGPG Visual CRS Reports ;
- +1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
- +2 ;
- NTL(RETVAL,BGPSTR) ;-- queue ngr
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPFN,BGPLOG
- +3 SET P="|"
- SET R="~"
- +4 SET BGPI=0
- +5 SET BGPERR=""
- +6 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
- +7 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
- +8 SET BGPYN=$PIECE(BGPSTR,P,2)
- +9 SET BGPOT=$PIECE(BGPSTR,P,3)
- +10 SET BGPOPT=$PIECE(BGPSTR,P,4)
- +11 SET BGPOPT="CRS 18 NATIONAL GPRA REPORT"
- +12 SET BGPRT=$PIECE(BGPSTR,P,5)
- +13 SET BGPMFITI=$PIECE(BGPSTR,P,6)
- +14 ;$P(BGPSTR,P,7)
- SET BGPYWCHW=0
- +15 SET BGPOM=$PIECE(BGPSTR,P,8)
- +16 SET BGPFN=$PIECE(BGPSTR,P,9)
- +17 SET BGPLOG=$PIECE(BGPSTR,P,10)
- +18 KILL ^BGPTMP($JOB)
- +19 SET RETVAL="^BGPTMP("_$JOB_")"
- +20 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +21 DO EP^BGP8GNTL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPYWCHW,BGPOM,BGPFN,BGPLOG)
- +22 SET BGPI=BGPI+1
- +23 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
- +24 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +25 DO EN^XBVK("BGP")
- +26 QUIT
- +27 ;
- NPL(RETVAL,BGPSTR) ;--queue nat lists
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL,BGPFN,BGPLOG
- +3 NEW BGPBLDT,BGPBEN
- +4 SET P="|"
- SET R="~"
- +5 SET BGPI=0
- +6 SET BGPERR=""
- +7 IF $GET(BGPSTR)=""
- DO CATSTR(.BGPSTR,.BGPSTR)
- +8 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
- +9 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
- +10 SET BGPDT=$PIECE(BGPSTR,P,2)
- +11 SET BGPPIEN=$PIECE($PIECE(BGPSTR,P,3),R)
- +12 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,3),R,2)
- +13 SET BGPOPT="CRS 18 NATIONAL PATIENT LISTS"
- +14 SET BGPOT=$PIECE(BGPSTR,P,4)
- +15 SET BGPRT=$PIECE(BGPSTR,P,5)
- +16 SET BGPQTR=$PIECE(BGPSTR,P,6)
- +17 SET BGPLST=$PIECE(BGPSTR,P,7)
- +18 SET BGPMFITI=$PIECE(BGPSTR,P,8)
- +19 SET BGPBLDT=$PIECE(BGPSTR,P,9)
- +20 SET BGPBEN=$PIECE(BGPSTR,P,10)
- +21 SET BGPFN=$PIECE(BGPSTR,P,11)
- +22 SET BGPLOG=$PIECE(BGPSTR,P,12)
- +23 NEW I
- +24 FOR I=13:1
- Begin DoDot:1
- +25 IF $PIECE(BGPSTR,P,I)=""
- QUIT
- +26 NEW BGPNSTR
- +27 SET BGPNSTR=$PIECE(BGPSTR,P,I)
- +28 SET BGPINDI=$PIECE(BGPNSTR,R)
- +29 IF $GET(BGPINDI)["*"
- SET BGPINDI=$PIECE(BGPINDI,"*")
- +30 SET BGPIND(BGPINDI)=""
- +31 NEW J
- +32 FOR J=2:1
- Begin DoDot:2
- +33 IF $PIECE(BGPNSTR,R,J)=""
- QUIT
- +34 NEW BGPSIND
- +35 SET BGPSIND=$PIECE(BGPNSTR,R,J)
- +36 IF $GET(BGPSIND)["*"
- SET BGPSIND=$PIECE(BGPSIND,"*")
- +37 SET BGPINDL(BGPINDI,BGPSIND)=""
- End DoDot:2
- IF $PIECE(BGPNSTR,R,J)=""
- QUIT
- End DoDot:1
- IF $PIECE(BGPSTR,P,I)=""
- QUIT
- +38 KILL ^BGPTMP($JOB)
- +39 SET RETVAL="^BGPTMP("_$JOB_")"
- +40 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +41 DO EP^BGP8GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN,BGPLOG)
- +42 SET BGPI=BGPI+1
- +43 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +44 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +45 DO EN^XBVK("BGP")
- +46 QUIT
- NPLS(RETVAL,BGPSTR) ;-- queue npl search template
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,B,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPINDL,BGPSTMP,BGPFN
- +3 NEW BGPBEN,BGPBASE,BGPSRCH
- +4 SET P="|"
- SET R="~"
- SET B="\"
- +5 SET BGPI=0
- +6 SET BGPERR=""
- +7 IF $GET(BGPSTR)=""
- DO CATSTR(.BGPSTR,.BGPSTR)
- +8 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
- +9 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
- +10 SET BGPDT=$PIECE(BGPSTR,P,2)
- +11 SET BGPPIEN=$PIECE($PIECE(BGPSTR,P,3),R)
- +12 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,3),R,2)
- +13 SET BGPOPT="CRS 18 NATIONAL PATIENT LIST SEARCH TEMPLATE"
- +14 SET BGPOT=$PIECE(BGPSTR,P,4)
- +15 SET BGPRT=$PIECE(BGPSTR,P,5)
- +16 SET BGPQTR=$PIECE(BGPSTR,P,6)
- +17 SET BGPLST=$PIECE(BGPSTR,P,7)
- +18 SET BGPMFITI=$PIECE(BGPSTR,P,8)
- +19 SET BGPBASE=$PIECE(BGPSTR,P,9)
- +20 SET BGPBEN=$PIECE(BGPSTR,P,10)
- +21 SET BGPFN=$PIECE(BGPSTR,P,11)
- +22 SET BGPSTMP=$PIECE(BGPSTR,B,2)
- +23 SET BGPSRCH=$PIECE($PIECE(BGPSTR,P,13),"&",2,9999)
- +24 NEW I
- +25 FOR I=13:1
- Begin DoDot:1
- +26 IF $PIECE(BGPSTR,P,I)=""
- QUIT
- +27 NEW BGPNSTR
- +28 SET BGPNSTR=$PIECE(BGPSTR,P,I)
- +29 SET BGPINDI=$PIECE(BGPNSTR,R)
- +30 IF $GET(BGPINDI)["*"
- SET BGPINDI=$PIECE(BGPINDI,"*")
- +31 SET BGPIND(BGPINDI)=""
- +32 NEW J
- +33 FOR J=2:1
- Begin DoDot:2
- +34 IF $PIECE(BGPNSTR,R,J)=""
- QUIT
- +35 IF $PIECE(BGPNSTR,R,J)["\"
- QUIT
- +36 NEW BGPSIND
- +37 SET BGPSIND=$PIECE(BGPNSTR,R,J)
- +38 IF $GET(BGPSIND)["&"
- SET BGPSIND=$PIECE(BGPSIND,"&")
- +39 IF '$GET(BGPSIND)
- QUIT
- +40 IF $GET(BGPSIND)["*"
- SET BGPSIND=$PIECE(BGPSIND,"*")
- +41 ;ihs/cmi/maw 3/30/2014 for new GUI v11.1
- IF $GET(BGPSRCH)]""
- SET BGPSTMP=$PIECE(BGPSRCH,"&",(J-1))
- +42 SET BGPINDL(BGPINDI,BGPSIND)=""
- +43 SET BGPINDL(BGPINDI,BGPSIND,"TEMP")=$GET(BGPSTMP)
- End DoDot:2
- IF $PIECE(BGPNSTR,R,J)=""
- QUIT
- End DoDot:1
- IF $PIECE(BGPSTR,P,I)=""
- QUIT
- +44 KILL ^BGPTMP($JOB)
- +45 SET RETVAL="^BGPTMP("_$JOB_")"
- +46 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +47 DO EP^BGP8GNST(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPLST,BGPPIEN,BGPPRV,BGPOT,BGPRT,BGPMFITI,BGPBASE,BGPBEN,BGPFN)
- +48 SET BGPI=BGPI+1
- +49 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +50 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +51 DO EN^XBVK("BGP")
- +52 QUIT
- COM(RETVAL,BGPSTR) ;sel measures by comm
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A
- +3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPIND,BGPINDI,BGPLSTI,BGPLOG
- +4 NEW BGPCOMM
- +5 SET P="|"
- SET R="~"
- SET A="*"
- +6 IF $GET(BGPSTR)=""
- DO CATSTR(.BGPSTR,.BGPSTR)
- +7 SET BGPI=0
- +8 SET BGPERR=""
- +9 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
- +10 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
- +11 SET BGPTP=$PIECE(BGPSTR,P,2)
- +12 SET BGPQTR=$PIECE(BGPSTR,P,3)
- +13 SET BGPRDT=$PIECE(BGPSTR,P,4)
- +14 SET BGPRE=$PIECE(BGPSTR,P,5)
- +15 SET BGPOPT="CRS 18 COM - SELECTED MEASURES REPORT"
- +16 SET BGPBAS=$PIECE(BGPSTR,P,6)
- +17 SET BGPPATT=$PIECE(BGPSTR,P,7)
- +18 SET BGPLIST=$PIECE(BGPSTR,P,8)
- +19 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,9),R)
- +20 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,9),R,2)
- +21 SET BGPOT=$PIECE(BGPSTR,P,10)
- +22 SET BGPFN=$PIECE(BGPSTR,P,14)
- +23 SET BGPINDI=$PIECE(BGPSTR,P,12)
- +24 SET BGPMFITI=$PIECE(BGPSTR,P,13)
- +25 SET BGPLSTI=$PIECE(BGPSTR,P,11)
- +26 SET BGPLOG=$PIECE(BGPSTR,P,15)
- +27 SET BGPCOMM=$PIECE(BGPSTR,P,16)
- +28 NEW I
- +29 FOR I=2:1
- Begin DoDot:1
- +30 IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +31 NEW BGPL
- +32 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
- +33 SET BGPLIST(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +34 NEW J
- +35 FOR J=2:1
- Begin DoDot:1
- +36 IF $PIECE(BGPINDI,A,J)=""
- QUIT
- +37 NEW BGPL
- +38 SET BGPL=$PIECE($PIECE(BGPINDI,A,J),R)
- +39 SET BGPIND(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPINDI,A,J)=""
- QUIT
- +40 KILL ^BGPTMP($JOB)
- +41 SET RETVAL="^BGPTMP("_$JOB_")"
- +42 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +43 DO EP^BGP8GCOM(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN,BGPLOG,BGPCOMM)
- +44 SET BGPI=BGPI+1
- +45 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +46 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +47 DO EN^XBVK("BGP")
- +48 QUIT
- +49 ;
- PP(RETVAL,BGPSTR) ;-- queue NGR
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPSEAT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN,BGPLOG
- +3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPSEAT,BGPIND,BGPINDG,BGPINDI,BGPLSTI
- +4 SET P="|"
- SET R="~"
- SET A="*"
- +5 IF $GET(BGPSTR)=""
- DO CATSTR(.BGPSTR,.BGPSTR)
- +6 SET BGPI=0
- +7 SET BGPERR=""
- +8 SET BGPTP=$PIECE(BGPSTR,P,2)
- +9 SET BGPQTR=$PIECE(BGPSTR,P,3)
- +10 SET BGPRDT=$PIECE(BGPSTR,P,4)
- +11 SET BGPRE=$PIECE(BGPSTR,P,5)
- +12 SET BGPOPT="CRS 18 PATIENT PANEL SELECTED MEASURES REPORT"
- +13 SET BGPBAS=$PIECE(BGPSTR,P,6)
- +14 SET BGPSEAT=$PIECE($PIECE(BGPSTR,P,7),R)
- +15 SET BGPLIST=$PIECE(BGPSTR,P,8)
- +16 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,9),R)
- +17 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,9),R,2)
- +18 SET BGPOT=$PIECE(BGPSTR,P,10)
- +19 SET BGPINDI=$PIECE(BGPSTR,P,12)
- +20 SET BGPLSTI=$PIECE(BGPSTR,P,11)
- +21 SET BGPFN=$PIECE(BGPSTR,P,13)
- +22 SET BGPLOG=$PIECE(BGPSTR,P,14)
- +23 NEW I
- +24 FOR I=2:1
- Begin DoDot:1
- +25 IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +26 NEW BGPL
- +27 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
- +28 SET BGPLIST(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +29 NEW J
- +30 FOR J=2:1
- Begin DoDot:1
- +31 IF $PIECE(BGPINDI,A,J)=""
- QUIT
- +32 NEW BGPL
- +33 SET BGPL=$PIECE($PIECE(BGPINDI,A,J),R)
- +34 SET BGPIND(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPINDI,A,J)=""
- QUIT
- +35 KILL ^BGPTMP($JOB)
- +36 SET RETVAL="^BGPTMP("_$JOB_")"
- +37 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +38 DO EP^BGP8GPP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPSEAT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPFN,BGPLOG)
- +39 SET BGPI=BGPI+1
- +40 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +41 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +42 DO EN^XBVK("BGP")
- +43 QUIT
- +44 ;
- ALL(RETVAL,BGPSTR) ;--selected with all comms
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPLOG
- +3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPIND,BGPINDG,BGPLSTI,BGPINDI,BGPFN
- +4 SET P="|"
- SET R="~"
- SET A="*"
- +5 IF $GET(BGPSTR)=""
- DO CATSTR(.BGPSTR,.BGPSTR)
- +6 SET BGPI=0
- +7 SET BGPERR=""
- +8 SET BGPTP=$PIECE(BGPSTR,P,2)
- +9 SET BGPQTR=$PIECE(BGPSTR,P,3)
- +10 SET BGPRDT=$PIECE(BGPSTR,P,4)
- +11 SET BGPRE=$PIECE(BGPSTR,P,5)
- +12 SET BGPOPT="CRS 18 ALL PATIENT SELECTED MEASURES REPORT"
- +13 SET BGPBAS=$PIECE(BGPSTR,P,6)
- +14 SET BGPPATT=$PIECE(BGPSTR,P,7)
- +15 SET BGPLIST=$PIECE(BGPSTR,P,8)
- +16 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,9),R)
- +17 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,9),R,2)
- +18 SET BGPOT=$PIECE(BGPSTR,P,10)
- +19 SET BGPINDI=$PIECE(BGPSTR,P,12)
- +20 SET BGPLSTI=$PIECE(BGPSTR,P,11)
- +21 SET BGPMFITI=$PIECE(BGPSTR,P,13)
- +22 SET BGPFN=$PIECE(BGPSTR,P,14)
- +23 SET BGPLOG=$PIECE(BGPSTR,P,15)
- +24 NEW I
- +25 FOR I=2:1
- Begin DoDot:1
- +26 IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +27 NEW BGPL
- +28 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
- +29 SET BGPLIST(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +30 NEW J
- +31 FOR J=2:1
- Begin DoDot:1
- +32 IF $PIECE(BGPINDI,A,J)=""
- QUIT
- +33 NEW BGPL
- +34 SET BGPL=$PIECE($PIECE(BGPINDI,A,J),R)
- +35 SET BGPIND(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPINDI,A,J)=""
- QUIT
- +36 KILL ^BGPTMP($JOB)
- +37 SET RETVAL="^BGPTMP("_$JOB_")"
- +38 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +39 DO EP^BGP8GALL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN,BGPLOG)
- +40 SET BGPI=BGPI+1
- +41 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +42 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +43 DO EN^XBVK("BGP")
- +44 QUIT
- +45 ;
- CMS(RETVAL,BGPSTR) ;
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPDT,BGPOT,BGPOPT,BGPRT,BGPPIEN,BGPPRV,BGPQTR,BGPLST,R,BGPIND,BGPBEN,BGPEXPL
- +3 NEW BGPEDT,BGPBDT,BGPFN
- +4 SET P="|"
- SET R="~"
- +5 SET BGPI=0
- +6 SET BGPERR=""
- +7 IF $GET(BGPSTR)=""
- DO CATSTR(.BGPSTR,.BGPSTR)
- +8 SET BGPCT=$PIECE(BGPSTR,P)
- +9 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^DIC(4,"B",BGPCT,0))
- +10 IF $PIECE(BGPCT,R)?.N
- SET BGPCT=$PIECE(BGPCT,R)
- +11 SET BGPDT=$PIECE(BGPSTR,P,2)
- +12 SET BGPBDT=$PIECE(BGPSTR,P,3)
- +13 SET BGPEDT=$PIECE(BGPSTR,P,4)
- +14 SET BGPOPT="CRS 18 CMS PERFORMANCE REPORT"
- +15 SET BGPRT=$PIECE(BGPSTR,P,7)
- +16 SET BGPQTR=$PIECE(BGPSTR,P,5)
- +17 SET BGPBEN=$PIECE(BGPSTR,P,6)
- +18 SET BGPEXPL=$PIECE(BGPSTR,P,8)
- +19 SET BGPFN=$PIECE(BGPSTR,P,9)
- +20 NEW I
- +21 FOR I=11:1
- Begin DoDot:1
- +22 IF $PIECE(BGPSTR,P,I)=""
- QUIT
- +23 NEW BGPNSTR
- +24 SET BGPNSTR=$PIECE(BGPSTR,P,I)
- +25 SET BGPINDI=$PIECE(BGPNSTR,R)
- +26 SET BGPIND(BGPINDI)=""
- +27 NEW J
- +28 FOR J=2:1
- Begin DoDot:2
- +29 IF $PIECE(BGPNSTR,R,J)=""
- QUIT
- +30 NEW BGPSIND
- +31 SET BGPSIND=$PIECE(BGPNSTR,R,J)
- +32 SET BGPINDL(BGPINDI,BGPSIND)=""
- End DoDot:2
- IF $PIECE(BGPNSTR,R,J)=""
- QUIT
- End DoDot:1
- IF $PIECE(BGPSTR,P,I)=""
- QUIT
- +33 KILL ^BGPTMP($JOB)
- +34 SET RETVAL="^BGPTMP("_$JOB_")"
- +35 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +36 DO EP^BGP8GCMS(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,.BGPIND,.BGPINDL,BGPQTR,BGPDT,BGPRT,BGPBDT,BGPEDT,BGPBEN,BGPEXPL,BGPFN)
- +37 SET BGPI=BGPI+1
- +38 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
- +39 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +40 DO EN^XBVK("BGP")
- +41 QUIT
- GPU(RETVAL,BGPSTR) ;-- queue ngr
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,BGPIND,BGPLIST
- +3 NEW BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPINDI,R,BGPFN,BGPYNPAN,BGPPAN,BGPFP,BGPDESP,BGPLOG
- +4 NEW BGPCOMM
- +5 SET P="|"
- SET R="~"
- +6 SET BGPI=0
- +7 SET BGPERR=""
- +8 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
- +9 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
- +10 SET BGPYN=$PIECE(BGPSTR,P,2)
- +11 SET BGPQTR=$PIECE(BGPSTR,P,3)
- +12 SET BGPRT=$PIECE(BGPSTR,P,4)
- +13 SET BGPRE=$PIECE(BGPSTR,P,5)
- +14 SET BGPBAS=$PIECE(BGPSTR,P,6)
- +15 SET BGPBEN=$PIECE(BGPSTR,P,7)
- +16 SET BGPOT=$PIECE(BGPSTR,P,8)
- +17 SET BGPMFITI=$PIECE(BGPSTR,P,9)
- +18 SET BGPFN=$PIECE(BGPSTR,P,10)
- +19 SET BGPYNPAN=$PIECE(BGPSTR,P,11)
- +20 SET BGPPAN=$PIECE(BGPSTR,P,12)
- +21 SET BGPFP=$PIECE(BGPSTR,P,13)
- +22 SET BGPDESP=$PIECE(BGPSTR,P,14)
- +23 SET BGPLOG=$PIECE(BGPSTR,P,15)
- +24 SET BGPCOMM=$PIECE(BGPSTR,P,16)
- +25 SET BGPOPT="CRS 18 GPU GPRA PERFORMANCE REPORT"
- +26 KILL ^BGPTMP($JOB)
- +27 SET RETVAL="^BGPTMP("_$JOB_")"
- +28 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +29 DO EP^BGP8GGPU(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPBEN,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPFN,BGPYNPAN,BGPPAN,BGPFP,BGPDESP,BGPLOG,BGPCOMM)
- +30 SET BGPI=BGPI+1
- +31 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
- +32 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +33 DO EN^XBVK("BGP")
- +34 QUIT
- +35 ;
- HED(RETVAL,BGPSTR) ;-- HEDIS Report
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A
- +3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPYN,BGPIND,BGPLIST,BGPFN
- +4 SET P="|"
- SET R="~"
- SET A="*"
- +5 IF $GET(BGPSTR)=""
- DO CATSTR(.BGPSTR,.BGPSTR)
- +6 SET BGPI=0
- +7 SET BGPERR=""
- +8 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
- +9 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
- +10 SET BGPYN=$PIECE(BGPSTR,P,2)
- +11 SET BGPQTR=$PIECE(BGPSTR,P,3)
- +12 SET BGPRDT=$PIECE(BGPSTR,P,4)
- +13 SET BGPRE=$PIECE(BGPSTR,P,5)
- +14 SET BGPOPT="CRS 18 HEDIS REPORT"
- +15 SET BGPBAS=$PIECE(BGPSTR,P,6)
- +16 SET BGPPATT=$PIECE(BGPSTR,P,7)
- +17 SET BGPLIST=$PIECE(BGPSTR,P,8)
- +18 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,9),R)
- +19 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,9),R,2)
- +20 SET BGPOT=$PIECE(BGPSTR,P,10)
- +21 SET BGPLSTI=$PIECE(BGPSTR,P,11)
- +22 SET BGPMFITI=$PIECE(BGPSTR,P,12)
- +23 SET BGPFN=$PIECE(BGPSTR,P,13)
- +24 NEW I
- +25 FOR I=2:1
- Begin DoDot:1
- +26 IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +27 NEW BGPL
- +28 SET BGPL=$PIECE($PIECE(BGPLSTI,A,I),R)
- +29 SET BGPLIST(BGPL)=""
- End DoDot:1
- IF $PIECE(BGPLSTI,A,I)=""
- QUIT
- +30 KILL ^BGPTMP($JOB)
- +31 SET RETVAL="^BGPTMP("_$JOB_")"
- +32 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +33 DO EP^BGP8GHED(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPYN,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPRDT,BGPMFITI,BGPFN)
- +34 SET BGPI=BGPI+1
- +35 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
- +36 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +37 DO EN^XBVK("BGP")
- +38 QUIT
- +39 ;
- LST(RETVAL,BGPSTR) ;-- list files
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPFN
- +3 SET P="|"
- SET R="~"
- +4 SET BGPI=0
- +5 SET BGPERR=""
- +6 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
- +7 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
- +8 SET BGPYN=$PIECE(BGPSTR,P,2)
- +9 SET BGPOT=$PIECE(BGPSTR,P,3)
- +10 SET BGPOPT=$PIECE(BGPSTR,P,4)
- +11 SET BGPRT=$PIECE(BGPSTR,P,5)
- +12 SET BGPFN=$PIECE(BGPSTR,P,6)
- +13 KILL ^BGPTMP($JOB)
- +14 SET RETVAL="^BGPTMP("_$JOB_")"
- +15 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +16 DO EP^BGP8GNPL(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPFN)
- +17 SET BGPI=BGPI+1
- +18 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +19 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +20 DO EN^XBVK("BGP")
- +21 QUIT
- +22 ;
- NPLST(RETVAL,BGPSTR) ;-- list files
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPFN
- +3 SET P="|"
- SET R="~"
- +4 SET BGPI=0
- +5 SET BGPERR=""
- +6 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
- +7 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
- +8 SET BGPYN=$PIECE(BGPSTR,P,2)
- +9 SET BGPOT=$PIECE(BGPSTR,P,3)
- +10 SET BGPOPT=$PIECE(BGPSTR,P,4)
- +11 SET BGPRT=$PIECE(BGPSTR,P,5)
- +12 SET BGPMFITI=$PIECE(BGPSTR,P,6)
- +13 SET BGPFN=$PIECE(BGPSTR,P,7)
- +14 KILL ^BGPTMP($JOB)
- +15 SET RETVAL="^BGPTMP("_$JOB_")"
- +16 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +17 DO EP^BGP8GNST(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPYN,BGPOT,BGPRT,BGPMFITI,BGPFN)
- +18 SET BGPI=BGPI+1
- +19 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +20 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +21 DO EN^XBVK("BGP")
- +22 QUIT
- ELD(RETVAL,BGPSTR) ;
- +1 GOTO ELD^BGP8GR1
- ONTL(RETVAL,BGPSTR) ;
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW P,BGPI,BGPDA,BGPRIEN,BGPNOD
- +3 SET P="|"
- +4 SET BGPRIEN=$PIECE(BGPSTR,P)
- +5 SET BGPNOD=11
- +6 IF $PIECE($GET(^BGPGUIR(BGPRIEN,0)),U,7)="X"
- SET BGPNOD=12
- +7 SET RETVAL="^BGPTMP("_$JOB_")"
- +8 SET BGPI=0
- +9 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +10 SET BGPDA=0
- FOR
- SET BGPDA=$ORDER(^BGPGUIR(BGPRIEN,BGPNOD,BGPDA))
- IF 'BGPDA
- QUIT
- Begin DoDot:1
- +11 SET BGPI=BGPI+1
- +12 SET ^BGPTMP($JOB,BGPI)=$GET(^BGPGUIR(BGPRIEN,BGPNOD,BGPDA,0))_$CHAR(30)
- End DoDot:1
- +13 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(X)
- +14 DO EN^XBVK("BGP")
- +15 QUIT
- +16 ;
- DNTL(RETVAL,BGPSTR) ;
- +1 SET X="MERR^BGP8GU"
- SET @^%ZOSF("TRAP")
- +2 NEW P,BGPI,BGPDA,BGPRIEN
- +3 SET P="|"
- +4 SET BGPRIEN=$PIECE(BGPSTR,P)
- +5 SET RETVAL="^BGPTMP("_$JOB_")"
- +6 SET BGPI=0
- +7 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +8 SET BGPDA=0
- FOR
- SET BGPDA=$ORDER(^BGPGUIR(BGPRIEN,12,BGPDA))
- IF 'BGPDA
- QUIT
- Begin DoDot:1
- +9 SET BGPI=BGPI+1
- +10 SET ^BGPTMP($JOB,BGPI)=$TRANSLATE($GET(^BGPGUIR(BGPRIEN,12,BGPDA,0)),"^","~")_$CHAR(30)
- End DoDot:1
- +11 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)_$GET(BGPERR)
- +12 DO EN^XBVK("BGP")
- +13 QUIT
- +14 ;
- CATSTR(BGPSRET,STR) ;EP
- +1 NEW BGPDA
- +2 SET BGPSRET=""
- +3 SET BGPDA=0
- FOR
- SET BGPDA=$ORDER(STR(BGPDA))
- IF 'BGPDA
- QUIT
- Begin DoDot:1
- +4 SET BGPSRET=BGPSRET_$GET(STR(BGPDA))
- End DoDot:1
- +5 QUIT
- +6 ;
