BGPMUXML ; IHS/MSC/MGH - MU XML output ;02-Mar-2011 14:07;DU
;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
;
;
PRINT1 ;EP
;if in NGR or GPU now print mu dev measures and divider page
N BGPGDEV,BGPDEVOR,BGPIC,BGPNOW,BGPXMLB,BGPXMLE,BGPXML,BGPREPD
S (BGPXMLB,BGPXMLE)=""
S BGPNOW=$$NOW^XLFDT
D XMLBEG
S BGPGDEV=1
S BGPDEVOR=0 F S BGPDEVOR=$O(^BGPMUIND(BGPMUYF,"ADO",BGPDEVOR)) Q:BGPDEVOR'=+BGPDEVOR!(BGPQUIT) D
.S BGPIC=$O(^BGPMUIND(BGPMUYF,"ADO",BGPDEVOR,0)) Q:BGPIC=""
.I $D(BGPIND(BGPIC)),$D(^BGPMUIND(BGPMUYF,BGPIC,5)) D
..K BGPXML
..X ^BGPMUIND(BGPMUYF,BGPIC,5)
..D XMLOUT
K BGPGDEV
D XMLEND
K BGPXML
Q
;
SAVEXML ;EP
;If screen selected do screen
I BGPDELT="S" D SCREEN,EXIT Q
;call xbgsave to create output file
S XBGL="BGPDATA"
L +^BGPDATA:300 E W:'$D(ZTQUEUED) "Unable to lock global" Q
K ^TMP($J,"SUMMARYXML")
K ^BGPDATA($J) ;global for saving
S X=0 F S X=$O(^TMP($J,"BGPXML",X)) Q:X'=+X I ^TMP($J,"BGPXML",X)'="ENDCOVERPAGE" S ^BGPDATA($J,X)=^TMP($J,"BGPXML",X)
I '$D(BGPGUI) D
.S XBFLT=1,XBFN=BGPDELF,XBMED="F",XBTLE="MEANINGFUL USE 2011 XML OUTPUT",XBQ="N",XBF=0
.D ^XBGSAVE
.K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF,X
I $D(BGPGUI) D
.S (C,X)=0 F S X=$O(^BGPDATA($J,X)) Q:X'=+X S C=C+1,^BGPGUIW(BGPGIEN,12,C,0)=^BGPDATA($J,X)
.S ^BGPGUIW(BGPGIEN,12,0)="^90546.1912^"_C_"^"_C_"^"_DT
L -^BGPDATA($J)
K ^BGPDATA($J) ;export global
D EXIT
Q
XMLBEG ;Create the beginning (fixed) portion for each XML file that will be generated
S Y="<?xml version=""1.0"" encoding=""UTF-8"" ?>" D S(Y,1,1)
S Y="<submission type=""PQRI-REGISTRY"" option=""TEST"" version=""2.0"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:noNamespaceSchemaLocation=""Registry_Payment.xsd"">" D S(Y,1,1)
S Y="<file-audit-data>" D S(Y,1,1)
S Y="<create-date>"_$$DATE(BGPNOW)_"</create-date>" D S(Y,1,1)
S Y="<create-time>"_$P($$FMTE^XLFDT(BGPNOW),"@",2)_"</create-time>" D S(Y,1,1)
S Y="<create-by>"_$$USR^BGPMUEP()_"</create-by>" D S(Y,1,1)
S Y="<version>1.0</version>" D S(Y,1,1)
S Y="<file-number>"_1_"</file-number>" D S(Y,1,1)
S Y="<number-of-files>"_1_"</number-of-files>" D S(Y,1,1)
S Y="</file-audit-data>" D S(Y,1,1)
S Y="<registry>" D S(Y,1,1)
S Y="<registry-name>"_"Sample Registry Name"_"</registry-name>" D S(Y,1,1)
S Y="<registry-id>"_"123456789"_"</registry-id>" D S(Y,1,1)
S Y="<submission-method>"_$S(BGPLEN=364:"A",1:"B")_"</submission-method>" D S(Y,1,1)
S Y="</registry>" D S(Y,1,1)
S Y="<measure-group ID=""X"">" D S(Y,1,1)
S Y="<provider>" D S(Y,1,1)
S Y="<npi>"_$S($G(BGPPROV)'="":$$NPI^BGPMUUT2(BGPPROV),1:"HOSPITAL")_"</npi>" D S(Y,1,1)
S Y="<tin>"_$S($G(BGPPROV)'="":$$TIN^BGPMUUT2(BGPPROV),1:"HOSPITAL")_"</tin>" D S(Y,1,1)
S Y="<waiver-signed>Y</waiver-signed>" D S(Y,1,1)
S Y="<encounter-from-date>"_$$DATE(BGPBD)_"</encounter-from-date>" D S(Y,1,1)
S Y="<encounter-to-date>"_$$DATE(BGPED)_"</encounter-to-date>" D S(Y,1,1)
Q
XMLEND ;Create the ending (fixed) portion for each XML file that will be generated
S Y="</provider>" D S(Y,1,1)
S Y="</measure-group>" D S(Y,1,1)
S Y="</submission>" D S(Y,1,1)
Q
XMLOUT ;add a <pqri-measure> block for each calculation in the BGPXML array
N OUTCNT
S OUTCNT=""
F S OUTCNT=$O(BGPXML(OUTCNT)) Q:OUTCNT'=+OUTCNT D
.S BGPREPD=BGPXML(OUTCNT)
.S Y="<pqri-measure>" D S(Y,1,1)
.S Y="<pqri-measure-number>"_$P(BGPREPD,U)_"</pqri-measure-number>" D S(Y,1,1)
.;S Y="<collection-method>A</collection-method>" ;PQRI 2010 addition
.S Y="<eligible-instances>"_$P(BGPREPD,U,3)_"</eligible-instances>" D S(Y,1,1)
.S Y="<meets-performance-instances>"_$P(BGPREPD,U,4)_"</meets-performance-instances>" D S(Y,1,1)
.S Y="<performance-exclusion-instances>"_$P(BGPREPD,U,5)_"</performance-exclusion-instances>" D S(Y,1,1)
.S Y="<performance-not-met-instances>"_($P(BGPREPD,U,3)-$P(BGPREPD,U,4)-$P(BGPREPD,U,5))_"</performance-not-met-instances>" D S(Y,1,1)
.S Y="<reporting-rate>100</reporting-rate>" D S(Y,1,1)
.S Y="<performance-rate>"_$S(($P(BGPREPD,U,3)-$P(BGPREPD,U,5))<1:"0",1:$$ROUND^BGPMUA01(($P(BGPREPD,U,4)/($P(BGPREPD,U,3)-$P(BGPREPD,U,5))),2))_"</performance-rate>" D S(Y,1,1)
.S Y="</pqri-measure>" D S(Y,1,1)
Q
SCREEN ;
S X=0 F S X=$O(^TMP($J,"BGPXML",X)) Q:X'=+X W:^TMP($J,"BGPXML",X)'="ENDCOVERPAGE" !,^TMP($J,"BGPXML",X)
Q
PRINT3 ;
Q
EXIT ;
K ^TMP($J)
Q
CTR(X,Y) ;EP - Center
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return user
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
S(Y,F,P) ;EP set up array
I '$G(F) S F=0
S %=$P(^TMP($J,"BGPXML",0),U)+F,$P(^TMP($J,"BGPXML",0),U)=%
I '$D(^TMP($J,"BGPXML",%)) S ^TMP($J,"BGPXML",%)=""
S $P(^TMP($J,"BGPXML",%),U,P)=Y
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q X
DATE(D) ;EP
I D="" Q ""
Q $E(D,4,5)_"-"_$E(D,6,7)_"-"_$E(D,2,3)
;
BGPMUXML ; IHS/MSC/MGH - MU XML output ;02-Mar-2011 14:07;DU
+1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
+2 ;
+3 ;
PRINT1 ;EP
+1 ;if in NGR or GPU now print mu dev measures and divider page
+2 NEW BGPGDEV,BGPDEVOR,BGPIC,BGPNOW,BGPXMLB,BGPXMLE,BGPXML,BGPREPD
+3 SET (BGPXMLB,BGPXMLE)=""
+4 SET BGPNOW=$$NOW^XLFDT
+5 DO XMLBEG
+6 SET BGPGDEV=1
+7 SET BGPDEVOR=0
FOR
SET BGPDEVOR=$ORDER(^BGPMUIND(BGPMUYF,"ADO",BGPDEVOR))
IF BGPDEVOR'=+BGPDEVOR!(BGPQUIT)
QUIT
Begin DoDot:1
+8 SET BGPIC=$ORDER(^BGPMUIND(BGPMUYF,"ADO",BGPDEVOR,0))
IF BGPIC=""
QUIT
+9 IF $DATA(BGPIND(BGPIC))
IF $DATA(^BGPMUIND(BGPMUYF,BGPIC,5))
Begin DoDot:2
+10 KILL BGPXML
+11 XECUTE ^BGPMUIND(BGPMUYF,BGPIC,5)
+12 DO XMLOUT
End DoDot:2
End DoDot:1
+13 KILL BGPGDEV
+14 DO XMLEND
+15 KILL BGPXML
+16 QUIT
+17 ;
SAVEXML ;EP
+1 ;If screen selected do screen
+2 IF BGPDELT="S"
DO SCREEN
DO EXIT
QUIT
+3 ;call xbgsave to create output file
+4 SET XBGL="BGPDATA"
+5 LOCK +^BGPDATA:300
IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE "Unable to lock global"
QUIT
+6 KILL ^TMP($JOB,"SUMMARYXML")
+7 ;global for saving
KILL ^BGPDATA($JOB)
+8 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPXML",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPXML",X)'="ENDCOVERPAGE"
SET ^BGPDATA($JOB,X)=^TMP($JOB,"BGPXML",X)
+9 IF '$DATA(BGPGUI)
Begin DoDot:1
+10 SET XBFLT=1
SET XBFN=BGPDELF
SET XBMED="F"
SET XBTLE="MEANINGFUL USE 2011 XML OUTPUT"
SET XBQ="N"
SET XBF=0
+11 DO ^XBGSAVE
+12 KILL XBFLT,XBFN,XBMED,XBTLE,XBE,XBF,X
End DoDot:1
+13 IF $DATA(BGPGUI)
Begin DoDot:1
+14 SET (C,X)=0
FOR
SET X=$ORDER(^BGPDATA($JOB,X))
IF X'=+X
QUIT
SET C=C+1
SET ^BGPGUIW(BGPGIEN,12,C,0)=^BGPDATA($JOB,X)
+15 SET ^BGPGUIW(BGPGIEN,12,0)="^90546.1912^"_C_"^"_C_"^"_DT
End DoDot:1
+16 LOCK -^BGPDATA($JOB)
+17 ;export global
KILL ^BGPDATA($JOB)
+18 DO EXIT
+19 QUIT
XMLBEG ;Create the beginning (fixed) portion for each XML file that will be generated
+1 SET Y="<?xml version=""1.0"" encoding=""UTF-8"" ?>"
DO S(Y,1,1)
+2 SET Y="<submission type=""PQRI-REGISTRY"" option=""TEST"" version=""2.0"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:noNamespaceSchemaLocation=""Registry_Payment.xsd"">"
DO S(Y,1,1)
+3 SET Y="<file-audit-data>"
DO S(Y,1,1)
+4 SET Y="<create-date>"_$$DATE(BGPNOW)_"</create-date>"
DO S(Y,1,1)
+5 SET Y="<create-time>"_$PIECE($$FMTE^XLFDT(BGPNOW),"@",2)_"</create-time>"
DO S(Y,1,1)
+6 SET Y="<create-by>"_$$USR^BGPMUEP()_"</create-by>"
DO S(Y,1,1)
+7 SET Y="<version>1.0</version>"
DO S(Y,1,1)
+8 SET Y="<file-number>"_1_"</file-number>"
DO S(Y,1,1)
+9 SET Y="<number-of-files>"_1_"</number-of-files>"
DO S(Y,1,1)
+10 SET Y="</file-audit-data>"
DO S(Y,1,1)
+11 SET Y="<registry>"
DO S(Y,1,1)
+12 SET Y="<registry-name>"_"Sample Registry Name"_"</registry-name>"
DO S(Y,1,1)
+13 SET Y="<registry-id>"_"123456789"_"</registry-id>"
DO S(Y,1,1)
+14 SET Y="<submission-method>"_$SELECT(BGPLEN=364:"A",1:"B")_"</submission-method>"
DO S(Y,1,1)
+15 SET Y="</registry>"
DO S(Y,1,1)
+16 SET Y="<measure-group ID=""X"">"
DO S(Y,1,1)
+17 SET Y="<provider>"
DO S(Y,1,1)
+18 SET Y="<npi>"_$SELECT($GET(BGPPROV)'="":$$NPI^BGPMUUT2(BGPPROV),1:"HOSPITAL")_"</npi>"
DO S(Y,1,1)
+19 SET Y="<tin>"_$SELECT($GET(BGPPROV)'="":$$TIN^BGPMUUT2(BGPPROV),1:"HOSPITAL")_"</tin>"
DO S(Y,1,1)
+20 SET Y="<waiver-signed>Y</waiver-signed>"
DO S(Y,1,1)
+21 SET Y="<encounter-from-date>"_$$DATE(BGPBD)_"</encounter-from-date>"
DO S(Y,1,1)
+22 SET Y="<encounter-to-date>"_$$DATE(BGPED)_"</encounter-to-date>"
DO S(Y,1,1)
+23 QUIT
XMLEND ;Create the ending (fixed) portion for each XML file that will be generated
+1 SET Y="</provider>"
DO S(Y,1,1)
+2 SET Y="</measure-group>"
DO S(Y,1,1)
+3 SET Y="</submission>"
DO S(Y,1,1)
+4 QUIT
XMLOUT ;add a <pqri-measure> block for each calculation in the BGPXML array
+1 NEW OUTCNT
+2 SET OUTCNT=""
+3 FOR
SET OUTCNT=$ORDER(BGPXML(OUTCNT))
IF OUTCNT'=+OUTCNT
QUIT
Begin DoDot:1
+4 SET BGPREPD=BGPXML(OUTCNT)
+5 SET Y="<pqri-measure>"
DO S(Y,1,1)
+6 SET Y="<pqri-measure-number>"_$PIECE(BGPREPD,U)_"</pqri-measure-number>"
DO S(Y,1,1)
+7 ;S Y="<collection-method>A</collection-method>" ;PQRI 2010 addition
+8 SET Y="<eligible-instances>"_$PIECE(BGPREPD,U,3)_"</eligible-instances>"
DO S(Y,1,1)
+9 SET Y="<meets-performance-instances>"_$PIECE(BGPREPD,U,4)_"</meets-performance-instances>"
DO S(Y,1,1)
+10 SET Y="<performance-exclusion-instances>"_$PIECE(BGPREPD,U,5)_"</performance-exclusion-instances>"
DO S(Y,1,1)
+11 SET Y="<performance-not-met-instances>"_($PIECE(BGPREPD,U,3)-$PIECE(BGPREPD,U,4)-$PIECE(BGPREPD,U,5))_"</performance-not-met-instances>"
DO S(Y,1,1)
+12 SET Y="<reporting-rate>100</reporting-rate>"
DO S(Y,1,1)
+13 SET Y="<performance-rate>"_$SELECT(($PIECE(BGPREPD,U,3)-$PIECE(BGPREPD,U,5))<1:"0",1:$$ROUND^BGPMUA01(($PIECE(BGPREPD,U,4)/($PIECE(BGPREPD,U,3)-$PIECE(BGPREPD,U,5))),2))_"</performance-rate>"
DO S(Y,1,1)
+14 SET Y="</pqri-measure>"
DO S(Y,1,1)
End DoDot:1
+15 QUIT
SCREEN ;
+1 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPXML",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPXML",X)'="ENDCOVERPAGE"
WRITE !,^TMP($JOB,"BGPXML",X)
+2 QUIT
PRINT3 ;
+1 QUIT
EXIT ;
+1 KILL ^TMP($JOB)
+2 QUIT
CTR(X,Y) ;EP - Center
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
USR() ;EP - Return user
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
S(Y,F,P) ;EP set up array
+1 IF '$GET(F)
SET F=0
+2 SET %=$PIECE(^TMP($JOB,"BGPXML",0),U)+F
SET $PIECE(^TMP($JOB,"BGPXML",0),U)=%
+3 IF '$DATA(^TMP($JOB,"BGPXML",%))
SET ^TMP($JOB,"BGPXML",%)=""
+4 SET $PIECE(^TMP($JOB,"BGPXML",%),U,P)=Y
+5 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
DATE(D) ;EP
+1 IF D=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"-"_$EXTRACT(D,6,7)_"-"_$EXTRACT(D,2,3)
+3 ;
