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

BGP2GTA.m

Go to the documentation of this file.
BGP2GTA ; IHS/CMI/LAB - BGPG Gui CRS Tables 2/2/2005 10:24:22 AM ;
 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
 ;
 ;
 ;
DIV(RETVAL) ;-- return all medical center divisions
 S X="MERR^BGP2GU",@^%ZOSF("TRAP") ; m error trap
 N BGPGI,BGPGDA
 S RETVAL="^BGPGTMP("_$J_")"
 S BGPGI=0
 S ^BGPGTMP($J,BGPGI)="T00050DIVISIONS"_$C(30)
 S BGPGDA=0 F  S BGPGDA=$O(^DG(40.8,"B",BGPGDA)) Q:BGPGDA=""  D
 . S BGPGI=BGPGI+1
 . S ^BGPGTMP($J,BGPGI)=BGPGDA_$C(30)
 S ^BGPGTMP($J,BGPGI+1)=$C(31)
 Q
 ;
GIALLC(RETVAL) ;-- get all GPRA measures for comm report
 S X="MERR^BGP2GU",@^%ZOSF("TRAP") ; m error trap
 N BGPI,X,Y,Z
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S BGPI=0
 S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00050Measure"_$C(30)
 S X=0 F  S X=$O(^BGPINDW("AOI",X)) Q:X'=+X  D
 . S Y=0 F  S Y=$O(^BGPINDW("AOI",X,Y)) Q:Y'=+Y  D
 .. Q:$P($G(^BGPINDW(Y,13)),U,1)=1
 .. ;Q:$P(^BGPINDW(Y,0),U,7)'=1
 .. S BGPI=BGPI+1
 .. S ^BGPTMP($J,BGPI)=Y_U_$P($G(^BGPINDW(Y,0)),U,3)_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
 Q
 ;
MUEP(RETVAL,BGPSTR) ;-- get measures based on user selection
 S X="MERR^BGP2GU",@^%ZOSF("TRAP") ; m error trap
 N BGPI,X,Y,Z,BGPLP,XREF,BGPMUYF,BGPVAL,BGPIEN
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S BGPI=0
 S BGPMUYF="90595.11"
 S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00100Measure"_$C(30)
 I BGPSTR="M" D
 . D INITM^BGPMUDSI
 I BGPSTR="S" D
 . D INIT^BGPMUDSI
 I BGPSTR="C" D  Q
 . D CI
 . N CDA
 . S CDA=0 F  S CDA=$O(BGPIND(CDA)) Q:'CDA  D
 .. S BGPI=BGPI+1
 .. S ^BGPTMP($J,BGPI)=CDA_$C(30)
 . S ^BGPTMP($J,BGPI+1)=$C(31)
 I BGPSTR="A" D  Q
 . D AI
 . N ADA
 . S ADA=0 F  S ADA=$O(BGPIND(ADA)) Q:'ADA  D
 .. S BGPI=BGPI+1
 .. S ^BGPTMP($J,BGPI)=ADA_$C(30)
 . S ^BGPTMP($J,BGPI+1)=$C(31)
 S X=0 F  S X=$O(BGPMUMEA(X)) Q:X'=+X  D
 . S BGPI=BGPI+1
 . S BGPIEN=$G(BGPMUMEA(X,X))
 . S BGPVAL=$G(BGPMUMEA(X,0))
 . I BGPSTR="M" S BGPVAL=$S($E(BGPVAL,2,4)=")  ":$E(BGPVAL,5,999),1:$E(BGPVAL,4,999))
 . I BGPSTR="S" S BGPVAL=$S($E(BGPVAL,2,4)=")  ":$E(BGPVAL,5,999),1:$E(BGPVAL,5,999))
 . S ^BGPTMP($J,BGPI)=BGPIEN_U_BGPVAL_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
 K BGPMUMEA
 Q
 ;
MUEPL(RETVAL,BGPSTR) ;-- get patient lists based on user selection
 S X="MERR^BGP2GU",@^%ZOSF("TRAP") ; m error trap
 N BGPI,X,Y,Z,BGPLP,XREF,BGPMUYF,BGPVAL,BGPIEN  ;,BGPNDI
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S BGPI=0
 S BGPMUYF="90595.11"
 F I=2:1 D  Q:$P(BGPSTR,"|",I)=""
 . S BGPNDI=$P(BGPSTR,"|",I)
 . Q:'$G(BGPNDI)
 . S BGPIND(BGPNDI)=""
 D INIT^BGPMUDSL
 S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00100Measure"_$C(30)
 S X=0 F  S X=$O(BGPMUGL(X)) Q:X'=+X  D
 . S BGPI=BGPI+1
 . S BGPIEN=$G(BGPMUGL("IDX",X,X))
 . S BGPVAL=$G(BGPMUGL(X,0))
 . S BGPVAL=$S($E(BGPVAL,2,4)=")  ":$E(BGPVAL,5,999),1:$E(BGPVAL,4,999))
 . S ^BGPTMP($J,BGPI)=BGPIEN_U_BGPVAL_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
 K BGPMUGL
 Q
 ;
MUHOS(RETVAL,BGPSTR) ;-- get measures based on user selection
 S X="MERR^BGP2GU",@^%ZOSF("TRAP") ; m error trap
 N BGPI,X,Y,Z,BGPLP,XREF,BGPMUYF,BGPVAL,BGPIEN
 K ^BGPTMP($J)
 S RETVAL="^BGPTMP("_$J_")"
 S BGPI=0
 S BGPMUYF="90595.11"
 S ^BGPTMP($J,BGPI)="T00007BMXIEN^T00100Measure"_$C(30)
 I BGPSTR="H" D  Q
 . D HI
 . N HDA
 . S HDA=0 F  S HDA=$O(BGPIND(HDA)) Q:'HDA  D
 .. S BGPI=BGPI+1
 .. S ^BGPTMP($J,BGPI)=HDA_$C(30)
 . S ^BGPTMP($J,BGPI+1)=$C(31)
 I BGPSTR="S" D
 . D INITH^BGPMUDSI
 S X=0 F  S X=$O(BGPMUMEA(X)) Q:X'=+X  D
 . S BGPI=BGPI+1
 . S BGPIEN=$G(BGPMUMEA(X,X))
 . S BGPVAL=$G(BGPMUMEA(X,0))
 . I BGPSTR="S" S BGPVAL=$S($E(BGPVAL,2,4)=")  ":$E(BGPVAL,5,999),1:$E(BGPVAL,5,999))
 . S ^BGPTMP($J,BGPI)=BGPIEN_U_BGPVAL_$C(30)
 S ^BGPTMP($J,BGPI+1)=$C(31)_$G(BGPERR)
 K BGPMUMEA
 Q
 ;
CI ;
 S BGPMUYF="90595.11"
 S X=0 F  S X=$O(^BGPMUIND(BGPMUYF,"AMS","C",X)) Q:X'=+X  S BGPIND(X)=""
 Q
AI ;
 S BGPMUYF="90595.11"
 S X=0 F  S X=$O(^BGPMUIND(BGPMUYF,"AMS","A",X)) Q:X'=+X  S BGPIND(X)=""
 Q
 ;
HI ;-- get all mu hospital indicators
 S BGPMUYF="90595.11"
 S X=0 F  S X=$O(^BGPMUIND(BGPMUYF,"AMS","H",X)) Q:X'=+X  S BGPIND(X)=""
 Q
 ;