- BGP6GR2 ; IHS/CMI/LAB - BGPG Visual CRS Reports 12/30/2004 12:29:35 PM 27 Apr 2010 10:30 PM ;
- ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- ;
- ;
- 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
- ;
- XP(RETVAL,BGPSTR) ;EP
- S X="MERR^BGP6GU",@^%ZOSF("TRAP")
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPEX,BGPLD,BGPRT
- ;BGPCT = COMMUNITY TAXONOMY IEN OR NAME
- ;BGPEX = EXPORT 1 or 0
- ;BGPLD = local files 1 or 0
- ;BGPRT = time to run report
- ;
- W !,BOMB
- 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 BGPCT=$O(^ATXAX("B",BGPCT,0))
- S BGPEX=$P(BGPSTR,P,2)
- S BGPLD=$P(BGPSTR,P,3)
- S BGPOPT="CR 11 COMPREHENSIVE NATIONAL EXPORT"
- S BGPMFITI=$P(BGPSTR,P,4) ;added for mfi v6.1
- S BGPRT=$P(BGPSTR,P,5)
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP6GNXP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPEX,BGPLD,BGPMFITI,BGPRT)
- S BGPI=BGPI+1
- S ^BGPTMP($J,BGPI)=+$G(BGPERR)_$C(30)
- S ^BGPTMP($J,BGPI+1)=$C(31)
- D EN^XBVK("BGP")
- Q
- ;
- PED(RETVAL,BGPSTR) ;EP
- S X="MERR^BGP6GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN,BGPRBG
- N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND,BGPLOG
- 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 BGPRBG=$P(BGPSTR,P,5)
- S BGPOPT="CRS 16 PATIENT EDUCATION 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 BGPEXP=$P(BGPSTR,P,10)
- S BGPOT=$P(BGPSTR,P,11)
- S BGPINDI=$P(BGPSTR,P,13)
- S BGPLSTI=$P(BGPSTR,P,12)
- S BGPMFITI=$P(BGPSTR,P,14)
- S BGPRE=$P(BGPSTR,P,15)
- S BGPFN=$P(BGPSTR,P,16)
- S BGPLOG=$P(BGPSTR,P,17)
- 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^BGP6GPED(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT,BGPMFITI,BGPFN,"",BGPRBG,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
- ;
- PEDPP(RETVAL,BGPSTR) ;EP
- S X="MERR^BGP6GU",@^%ZOSF("TRAP") ; m error trap
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPST,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN,BGPSTMP,BGPRBG
- N BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND,BGPLOG
- S P="|",R="~",A="*"
- I $G(BGPSTR)="" D CATSTR(.BGPSTR,.BGPSTR)
- S BGPI=0
- S BGPERR=""
- S BGPST=$P($P(BGPSTR,P),R)
- I $P(BGPST,R)'?.N S BGPST=$O(^DIBT("B",BGPST,0))
- S BGPTP=$P(BGPSTR,P,2)
- S BGPQTR=$P(BGPSTR,P,3)
- S BGPRDT=$P(BGPSTR,P,4)
- S BGPRBG=$P(BGPSTR,P,5)
- S BGPOPT="CRS 16 PATIENT EDUCATION 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 BGPEXP=$P(BGPSTR,P,10)
- S BGPOT=$P(BGPSTR,P,11)
- S BGPINDI=$P(BGPSTR,P,13)
- S BGPLSTI=$P(BGPSTR,P,12)
- S BGPMFITI=$P(BGPSTR,P,14)
- S BGPRE=$P(BGPSTR,P,15)
- S BGPFN=$P(BGPSTR,P,16)
- S BGPLOG=$P(BGPSTR,P,17)
- 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^BGP6GPED(.BGPERR,DUZ,DUZ(2),BGPOPT,"",BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT,BGPMFITI,BGPFN,BGPST,BGPRBG,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
- ;
- LHW(RETVAL,BGPSTR) ;EP
- S X="MERR^BGP6GU",@^%ZOSF("TRAP")
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPEX,BGPLD,BGPRT,BGPMFITI,BGPOM,BGPOT,BGPFN
- ;BGPCT = COMMUNITY TAXONOMY IEN OR NAME
- ;BGPEX = EXPORT 1 or 0
- ;BGPLD = local files 1 or 0
- ;BGPRT = time to run report
- ;
- 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 BGPCT=$O(^ATXAX("B",BGPCT,0))
- S BGPOM=$P(BGPSTR,P,3)
- S BGPOPT="CRS 16 LOCAL HT/WT"
- S BGPMFITI=$P(BGPSTR,P,2) ;added for mfi v6.1
- S BGPRT=$P(BGPSTR,P,5)
- S BGPOT=$P(BGPSTR,P,4)
- S BGPFN=$P(BGPSTR,P,6)
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP6GLHW(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPMFITI,BGPOM,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
- ;
- CMP(RETVAL,BGPSTR) ;EP
- S X="MERR^BGP6GU",@^%ZOSF("TRAP")
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPQTR,BGPRDT,BGPRE,BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPOPT,BGPRT,R
- N BGPBEN,BGPBLDT,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 BGPQTR=$P(BGPSTR,P,2)
- S BGPRDT=$P(BGPSTR,P,3)
- S BGPRE=$P(BGPSTR,P,4)
- S BGPOPT="CRS 16 NATIONAL GPRA COMPREHENSIVE PATIENT LIST"
- S BGPLIST=$P(BGPSTR,P,5)
- S BGPPRV=$P($P(BGPSTR,P,6),R)
- S BGPPROV=$P($P(BGPSTR,P,6),R,2)
- S BGPOT=$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)
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP6GCMP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLIST,BGPPRV,BGPPROV,BGPQTR,BGPRE,BGPCT,BGPOT,BGPRDT,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
- ;
- DASH(RETVAL,BGPSTR) ;-- dashboard report
- S X="MERR^BGP6GU",@^%ZOSF("TRAP")
- N BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPFN,BGPYR,BGPPRV
- 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 16 NATIONAL GPRA DASHBOARD REPORT"
- S BGPRT=$P(BGPSTR,P,5)
- S BGPMFITI=$P(BGPSTR,P,6)
- S BGPYWCHW=0 ;$P(BGPSTR,P,7) LAB/V13
- S BGPOM=$P(BGPSTR,P,8)
- S BGPFN=$P(BGPSTR,P,9)
- S BGPYR=$P(BGPSTR,P,10)
- S BGPPRV=$P(BGPSTR,P,11)
- K ^BGPTMP($J)
- S RETVAL="^BGPTMP("_$J_")"
- S ^BGPTMP($J,BGPI)="T00250DATA"_$C(30)
- D EP^BGP6GDSH(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPOT,BGPRT,BGPMFITI,BGPFN,BGPYR,BGPPRV)
- S BGPI=BGPI+1
- S ^BGPTMP($J,BGPI)=$G(BGPERR)_$C(30)
- S ^BGPTMP($J,BGPI+1)=$C(31)
- D EN^XBVK("BGP")
- Q
- ;
- BGP6GR2 ; IHS/CMI/LAB - BGPG Visual CRS Reports 12/30/2004 12:29:35 PM 27 Apr 2010 10:30 PM ;
- +1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- +2 ;
- +3 ;
- 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 ;
- XP(RETVAL,BGPSTR) ;EP
- +1 SET X="MERR^BGP6GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPEX,BGPLD,BGPRT
- +3 ;BGPCT = COMMUNITY TAXONOMY IEN OR NAME
- +4 ;BGPEX = EXPORT 1 or 0
- +5 ;BGPLD = local files 1 or 0
- +6 ;BGPRT = time to run report
- +7 ;
- +8 WRITE !,BOMB
- +9 SET P="|"
- SET R="~"
- +10 SET BGPI=0
- +11 SET BGPERR=""
- +12 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
- +13 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
- +14 ;S BGPCT=$O(^ATXAX("B",BGPCT,0))
- +15 SET BGPEX=$PIECE(BGPSTR,P,2)
- +16 SET BGPLD=$PIECE(BGPSTR,P,3)
- +17 SET BGPOPT="CR 11 COMPREHENSIVE NATIONAL EXPORT"
- +18 ;added for mfi v6.1
- SET BGPMFITI=$PIECE(BGPSTR,P,4)
- +19 SET BGPRT=$PIECE(BGPSTR,P,5)
- +20 KILL ^BGPTMP($JOB)
- +21 SET RETVAL="^BGPTMP("_$JOB_")"
- +22 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +23 DO EP^BGP6GNXP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPEX,BGPLD,BGPMFITI,BGPRT)
- +24 SET BGPI=BGPI+1
- +25 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +26 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +27 DO EN^XBVK("BGP")
- +28 QUIT
- +29 ;
- PED(RETVAL,BGPSTR) ;EP
- +1 ; m error trap
- SET X="MERR^BGP6GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN,BGPRBG
- +3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND,BGPLOG
- +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 BGPTP=$PIECE(BGPSTR,P,2)
- +11 SET BGPQTR=$PIECE(BGPSTR,P,3)
- +12 SET BGPRDT=$PIECE(BGPSTR,P,4)
- +13 SET BGPRBG=$PIECE(BGPSTR,P,5)
- +14 SET BGPOPT="CRS 16 PATIENT EDUCATION 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 BGPEXP=$PIECE(BGPSTR,P,10)
- +21 SET BGPOT=$PIECE(BGPSTR,P,11)
- +22 SET BGPINDI=$PIECE(BGPSTR,P,13)
- +23 SET BGPLSTI=$PIECE(BGPSTR,P,12)
- +24 SET BGPMFITI=$PIECE(BGPSTR,P,14)
- +25 SET BGPRE=$PIECE(BGPSTR,P,15)
- +26 SET BGPFN=$PIECE(BGPSTR,P,16)
- +27 SET BGPLOG=$PIECE(BGPSTR,P,17)
- +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^BGP6GPED(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT,BGPMFITI,BGPFN,"",BGPRBG,BGPLOG)
- +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 ;
- PEDPP(RETVAL,BGPSTR) ;EP
- +1 ; m error trap
- SET X="MERR^BGP6GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPST,BGPOT,BGPOPT,BGPRT,P,R,A,BGPFN,BGPSTMP,BGPRBG
- +3 NEW BGPTP,BGPQTR,BGPRDT,BGPRE,BGPBAS,BGPPATT,BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPIND,BGPLOG
- +4 SET P="|"
- SET R="~"
- SET A="*"
- +5 IF $GET(BGPSTR)=""
- DO CATSTR(.BGPSTR,.BGPSTR)
- +6 SET BGPI=0
- +7 SET BGPERR=""
- +8 SET BGPST=$PIECE($PIECE(BGPSTR,P),R)
- +9 IF $PIECE(BGPST,R)'?.N
- SET BGPST=$ORDER(^DIBT("B",BGPST,0))
- +10 SET BGPTP=$PIECE(BGPSTR,P,2)
- +11 SET BGPQTR=$PIECE(BGPSTR,P,3)
- +12 SET BGPRDT=$PIECE(BGPSTR,P,4)
- +13 SET BGPRBG=$PIECE(BGPSTR,P,5)
- +14 SET BGPOPT="CRS 16 PATIENT EDUCATION 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 BGPEXP=$PIECE(BGPSTR,P,10)
- +21 SET BGPOT=$PIECE(BGPSTR,P,11)
- +22 SET BGPINDI=$PIECE(BGPSTR,P,13)
- +23 SET BGPLSTI=$PIECE(BGPSTR,P,12)
- +24 SET BGPMFITI=$PIECE(BGPSTR,P,14)
- +25 SET BGPRE=$PIECE(BGPSTR,P,15)
- +26 SET BGPFN=$PIECE(BGPSTR,P,16)
- +27 SET BGPLOG=$PIECE(BGPSTR,P,17)
- +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^BGP6GPED(.BGPERR,DUZ,DUZ(2),BGPOPT,"",BGPTP,.BGPIND,BGPQTR,BGPRE,BGPBAS,BGPPATT,BGPLIST,.BGPLIST,BGPPRV,BGPPROV,BGPEXP,BGPOT,BGPRDT,BGPMFITI,BGPFN,BGPST,BGPRBG,BGPLOG)
- +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 ;
- LHW(RETVAL,BGPSTR) ;EP
- +1 SET X="MERR^BGP6GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPEX,BGPLD,BGPRT,BGPMFITI,BGPOM,BGPOT,BGPFN
- +3 ;BGPCT = COMMUNITY TAXONOMY IEN OR NAME
- +4 ;BGPEX = EXPORT 1 or 0
- +5 ;BGPLD = local files 1 or 0
- +6 ;BGPRT = time to run report
- +7 ;
- +8 SET P="|"
- SET R="~"
- +9 SET BGPI=0
- +10 SET BGPERR=""
- +11 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
- +12 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
- +13 ;S BGPCT=$O(^ATXAX("B",BGPCT,0))
- +14 SET BGPOM=$PIECE(BGPSTR,P,3)
- +15 SET BGPOPT="CRS 16 LOCAL HT/WT"
- +16 ;added for mfi v6.1
- SET BGPMFITI=$PIECE(BGPSTR,P,2)
- +17 SET BGPRT=$PIECE(BGPSTR,P,5)
- +18 SET BGPOT=$PIECE(BGPSTR,P,4)
- +19 SET BGPFN=$PIECE(BGPSTR,P,6)
- +20 KILL ^BGPTMP($JOB)
- +21 SET RETVAL="^BGPTMP("_$JOB_")"
- +22 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +23 DO EP^BGP6GLHW(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPMFITI,BGPOM,BGPOT,BGPRT,BGPFN)
- +24 SET BGPI=BGPI+1
- +25 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
- +26 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +27 DO EN^XBVK("BGP")
- +28 QUIT
- +29 ;
- CMP(RETVAL,BGPSTR) ;EP
- +1 SET X="MERR^BGP6GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPQTR,BGPRDT,BGPRE,BGPLIST,BGPPRV,BGPPROV,BGPOT,BGPOPT,BGPRT,R
- +3 NEW BGPBEN,BGPBLDT,BGPFN,BGPLOG
- +4 SET P="|"
- SET R="~"
- +5 SET BGPI=0
- +6 SET BGPERR=""
- +7 SET BGPCT=$PIECE($PIECE(BGPSTR,P),R)
- +8 IF $PIECE(BGPCT,R)'?.N
- SET BGPCT=$ORDER(^ATXAX("B",BGPCT,0))
- +9 SET BGPQTR=$PIECE(BGPSTR,P,2)
- +10 SET BGPRDT=$PIECE(BGPSTR,P,3)
- +11 SET BGPRE=$PIECE(BGPSTR,P,4)
- +12 SET BGPOPT="CRS 16 NATIONAL GPRA COMPREHENSIVE PATIENT LIST"
- +13 SET BGPLIST=$PIECE(BGPSTR,P,5)
- +14 SET BGPPRV=$PIECE($PIECE(BGPSTR,P,6),R)
- +15 SET BGPPROV=$PIECE($PIECE(BGPSTR,P,6),R,2)
- +16 SET BGPOT=$PIECE(BGPSTR,P,7)
- +17 SET BGPMFITI=$PIECE(BGPSTR,P,8)
- +18 SET BGPBLDT=$PIECE(BGPSTR,P,9)
- +19 SET BGPBEN=$PIECE(BGPSTR,P,10)
- +20 SET BGPFN=$PIECE(BGPSTR,P,11)
- +21 SET BGPLOG=$PIECE(BGPSTR,P,12)
- +22 KILL ^BGPTMP($JOB)
- +23 SET RETVAL="^BGPTMP("_$JOB_")"
- +24 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +25 DO EP^BGP6GCMP(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPLIST,BGPPRV,BGPPROV,BGPQTR,BGPRE,BGPCT,BGPOT,BGPRDT,BGPMFITI,BGPBLDT,BGPBEN,BGPFN,BGPLOG)
- +26 SET BGPI=BGPI+1
- +27 SET ^BGPTMP($JOB,BGPI)=+$GET(BGPERR)_$CHAR(30)
- +28 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +29 DO EN^XBVK("BGP")
- +30 QUIT
- +31 ;
- DASH(RETVAL,BGPSTR) ;-- dashboard report
- +1 SET X="MERR^BGP6GU"
- SET @^%ZOSF("TRAP")
- +2 NEW BGPI,BGPJ,BGPDATA,BGPDA,P,BGPERR,BGPCT,BGPYN,BGPOT,BGPOPT,BGPRT,R,BGPOM,BGPFN,BGPYR,BGPPRV
- +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 16 NATIONAL GPRA DASHBOARD REPORT"
- +12 SET BGPRT=$PIECE(BGPSTR,P,5)
- +13 SET BGPMFITI=$PIECE(BGPSTR,P,6)
- +14 ;$P(BGPSTR,P,7) LAB/V13
- SET BGPYWCHW=0
- +15 SET BGPOM=$PIECE(BGPSTR,P,8)
- +16 SET BGPFN=$PIECE(BGPSTR,P,9)
- +17 SET BGPYR=$PIECE(BGPSTR,P,10)
- +18 SET BGPPRV=$PIECE(BGPSTR,P,11)
- +19 KILL ^BGPTMP($JOB)
- +20 SET RETVAL="^BGPTMP("_$JOB_")"
- +21 SET ^BGPTMP($JOB,BGPI)="T00250DATA"_$CHAR(30)
- +22 DO EP^BGP6GDSH(.BGPERR,DUZ,DUZ(2),BGPOPT,BGPCT,BGPOT,BGPRT,BGPMFITI,BGPFN,BGPYR,BGPPRV)
- +23 SET BGPI=BGPI+1
- +24 SET ^BGPTMP($JOB,BGPI)=$GET(BGPERR)_$CHAR(30)
- +25 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
- +26 DO EN^XBVK("BGP")
- +27 QUIT
- +28 ;
