BGPMUXML.m

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       ;