BGP4GMTX.m

BGP4GMTX ; IHS/CMI/LAB - IHS Diabetes Audit 2003 ;

 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 ;

 ;

TESTCMP ;

 S ERR=""

 D EP(.ERR,1,2522,"BGP 14 MED TAX REPORT",$$NOW^XLFDT)

 W !,ERR

 Q

EP(BGPRET,BGPUSER,BGPDUZ2,BGPOPTN,BGPRTIME,BGPRT,BGPFILE) ;EP - called from GUI to produce national gpra report (NTL-GP)

 ;  BGPUSER - DUZ

 ;  BGPDUZ2 - DUZ(2)

 ;  BGPOPTN - OPTION NAME = "BGP 14 COMPREHENSIVE PAT LIST"

 ;  

 ;  BGPRTIME - report will be queued automatically, this variable

 ;             contains the time it will run, internal fileman format

 ;             must be date and time

 ;

 ;  BGPRET - return value is ien^error message^export file name. a zero (0) is

 ;  passed as ien if error occurred, display the filename back to the user

 ;  if they chose to export to area

 ;

 ;create entry in gui output file

 ;queue report to run with/GUIR

 D EP1

 S Y=BGPRET

 ;D EN^XBVK("BGP") S:$D(ZTQUEUED) ZTREQ="@"

 S BGPRET=Y

 Q

EP1 ;

 S U="^"

 I $G(BGPUSER)="" S BGPRET=0_"^USER NOT PASSED" Q

 I $G(BGPDUZ2)="" S BGPRET=0_"^DUZ(2) NOT PASSED" Q

 I $G(BGPOPTN)="" S BGPRET=0_"^OPTION NAME NOT PASSED" Q

 S BGPRTIME=$G(BGPRTIME)

 ;S DUZ=BGPUSER

 S DUZ(2)=BGPDUZ2

 S:'$D(DT) DT=$$DT^XLFDT

 D ^XBKVAR

 S BGPGUI=1

 S IOM=80,BGPIOSL=55

 S BGPDELT=""

 ;create entry in GUI file

 D ^XBFMK

 S X=BGPFILE

 S BGPGFNM=X

 S DIC="^BGPGUIJ(",DIC(0)="L",DIADD=1,DLAYGO=90552.19,DIC("DR")=".02////"_BGPUSER_";.03////"_$S(BGPRTIME]"":BGPRTIME,1:$$NOW^XLFDT)_";.05///"_BGPOPTN_";.06///R;.07///P"

 K DD,D0,DO D FILE^DICN K DLAYGO,DIADD,DD,D0,DO

 I Y=-1 S BGPRET=0_"^UNABLE TO CREATE ENTRY IN GUI OUTPUT FILE" Q

 S BGPGIEN=+Y

 ;SEND THE REPORT PROCESS OFF TO THE BACKGROUND USING TASKMAN CALL

 D TSKMN

 S BGPRET=BGPGIEN

 Q

 ;

TSKMN ;

 S ZTIO=""

 K ZTSAVE S ZTSAVE("*")=""

 S ZTCPU=$G(IOCPU),ZTRTN="LTX^BGP4GMTX",ZTDTH=$S(BGPRTIME]"":BGPRTIME,1:$$NOW^XLFDT),ZTDESC="GUI MEDICATION TAXONOMY REPORT" D ^%ZTLOAD Q

 Q

LTX ;

 K ^TMP($J,"BGPGUI")

 S IOM=80,BGPIOSL=55

 D @$S(BGPRT=1:"GPRA^BGP4DMT",BGPRT=7:"ONM^BGP4DMT",BGPRT=2:"CRS^BGP4DMT",BGPRT=4:"ELDER^BGP4DMT",BGPRT=3:"HEDIS^BGP4DMT",BGPRT=5:"CMS^BGP4DMT",BGPRT=8:"EO^BGP4DMT")  ;cmi/maw added 10/30/2010

 D GUIR^BGPXBLM("PRINT^BGP4DMT","^TMP($J,""BGPGUI"",")

 S X=0,C=0 F  S X=$O(^TMP($J,"BGPGUI",X)) Q:X'=+X  D

 . S C=C+1

 . N BGPDATA

 . S BGPDATA=$G(^TMP($J,"BGPGUI",X))

 . I BGPDATA="ZZZZZZZ" S BGPDATA=$C(12)

 . S ^BGPGUIJ(BGPGIEN,11,C,0)=BGPDATA

 S ^BGPGUIJ(BGPGIEN,11,0)="^90552.1911^"_C_"^"_C_"^"_DT

 K ^TMP($J,"BGPGUI")

 D ENDLOG

 D XIT

 Q

 ;

XIT ;

 K ^TMP($J)

 ;D EN^XBVK("BGP") done in MEDTAXC^BGP4GU

 S:$D(ZTQUEUED) ZTREQ="@"

 K DIRUT,DUOUT,DIR,DOD

 K DIADD,DLAYGO

 D KILL^AUPNPAT

 K X,X1,X2,X3,X4,X5,X6

 K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 K N,N1,N2,N3,N4,N5,N6

 K BD,ED

 D KILL^AUPNPAT

 D ^XBFMK

 L -^BGPDATA

 Q

 ;

ENDLOG ;-- UPDATE LOG AT END

 S DIE="^BGPGUIJ(",DA=BGPGIEN,DR=".04////"_$$NOW^XLFDT_";.06///C"

 D ^DIE

 K DIE,DR,DA

 Q

BGP4GMTX  ; IHS/CMI/LAB - IHS Diabetes Audit 2003 ;

 +1       ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 +2       ;

 +3       ;

TESTCMP   ;

 +1        SET ERR=""

 +2        DO EP(.ERR,1,2522,"BGP 14 MED TAX REPORT",$$NOW^XLFDT)

 +3        WRITE !,ERR

 +4        QUIT 

EP(BGPRET,BGPUSER,BGPDUZ2,BGPOPTN,BGPRTIME,BGPRT,BGPFILE) ;EP - called from GUI to produce national gpra report (NTL-GP)

 +1       ;  BGPUSER - DUZ

 +2       ;  BGPDUZ2 - DUZ(2)

 +3       ;  BGPOPTN - OPTION NAME = "BGP 14 COMPREHENSIVE PAT LIST"

 +4       ;  

 +5       ;  BGPRTIME - report will be queued automatically, this variable

 +6       ;             contains the time it will run, internal fileman format

 +7       ;             must be date and time

 +8       ;

 +9       ;  BGPRET - return value is ien^error message^export file name. a zero (0) is

 +10      ;  passed as ien if error occurred, display the filename back to the user

 +11      ;  if they chose to export to area

 +12      ;

 +13      ;create entry in gui output file

 +14      ;queue report to run with/GUIR

 +15       DO EP1

 +16       SET Y=BGPRET

 +17      ;D EN^XBVK("BGP") S:$D(ZTQUEUED) ZTREQ="@"

 +18       SET BGPRET=Y

 +19       QUIT 

EP1       ;

 +1        SET U="^"

 +2        IF $GET(BGPUSER)=""

               SET BGPRET=0_"^USER NOT PASSED"

               QUIT 

 +3        IF $GET(BGPDUZ2)=""

               SET BGPRET=0_"^DUZ(2) NOT PASSED"

               QUIT 

 +4        IF $GET(BGPOPTN)=""

               SET BGPRET=0_"^OPTION NAME NOT PASSED"

               QUIT 

 +5        SET BGPRTIME=$GET(BGPRTIME)

 +6       ;S DUZ=BGPUSER

 +7        SET DUZ(2)=BGPDUZ2

 +8        IF '$DATA(DT)

               SET DT=$$DT^XLFDT

 +9        DO ^XBKVAR

 +10       SET BGPGUI=1

 +11       SET IOM=80

           SET BGPIOSL=55

 +12       SET BGPDELT=""

 +13      ;create entry in GUI file

 +14       DO ^XBFMK

 +15       SET X=BGPFILE

 +16       SET BGPGFNM=X

 +17       SET DIC="^BGPGUIJ("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=90552.19

           SET DIC("DR")=".02////"_BGPUSER_";.03////"_$SELECT(BGPRTIME]"":BGPRTIME,1:$$NOW^XLFDT)_";.05///"_BGPOPTN_";.06///R;.07///P"

 +18       KILL DD,D0,DO

           DO FILE^DICN

           KILL DLAYGO,DIADD,DD,D0,DO

 +19       IF Y=-1

               SET BGPRET=0_"^UNABLE TO CREATE ENTRY IN GUI OUTPUT FILE"

               QUIT 

 +20       SET BGPGIEN=+Y

 +21      ;SEND THE REPORT PROCESS OFF TO THE BACKGROUND USING TASKMAN CALL

 +22       DO TSKMN

 +23       SET BGPRET=BGPGIEN

 +24       QUIT 

 +25      ;

TSKMN     ;

 +1        SET ZTIO=""

 +2        KILL ZTSAVE

           SET ZTSAVE("*")=""

 +3        SET ZTCPU=$GET(IOCPU)

           SET ZTRTN="LTX^BGP4GMTX"

           SET ZTDTH=$SELECT(BGPRTIME]"":BGPRTIME,1:$$NOW^XLFDT)

           SET ZTDESC="GUI MEDICATION TAXONOMY REPORT"

           DO ^%ZTLOAD

           QUIT 

 +4        QUIT 

LTX       ;

 +1        KILL ^TMP($JOB,"BGPGUI")

 +2        SET IOM=80

           SET BGPIOSL=55

 +3       ;cmi/maw added 10/30/2010

           DO @$SELECT(BGPRT=1:"GPRA^BGP4DMT",BGPRT=7:"ONM^BGP4DMT",BGPRT=2:"CRS^BGP4DMT",BGPRT=4:"ELDER^BGP4DMT",BGPRT=3:"HEDIS^BGP4DMT",BGPRT=5:"CMS^BGP4DMT",BGPRT=8:"EO^BGP4DMT")

 +4        DO GUIR^BGPXBLM("PRINT^BGP4DMT","^TMP($J,""BGPGUI"",")

 +5        SET X=0

           SET C=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPGUI",X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +6                SET C=C+1

 +7                NEW BGPDATA

 +8                SET BGPDATA=$GET(^TMP($JOB,"BGPGUI",X))

 +9                IF BGPDATA="ZZZZZZZ"

                       SET BGPDATA=$CHAR(12)

 +10               SET ^BGPGUIJ(BGPGIEN,11,C,0)=BGPDATA

               End DoDot:1

 +11       SET ^BGPGUIJ(BGPGIEN,11,0)="^90552.1911^"_C_"^"_C_"^"_DT

 +12       KILL ^TMP($JOB,"BGPGUI")

 +13       DO ENDLOG

 +14       DO XIT

 +15       QUIT 

 +16      ;

XIT       ;

 +1        KILL ^TMP($JOB)

 +2       ;D EN^XBVK("BGP") done in MEDTAXC^BGP4GU

 +3        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +4        KILL DIRUT,DUOUT,DIR,DOD

 +5        KILL DIADD,DLAYGO

 +6        DO KILL^AUPNPAT

 +7        KILL X,X1,X2,X3,X4,X5,X6

 +8        KILL A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 +9        KILL N,N1,N2,N3,N4,N5,N6

 +10       KILL BD,ED

 +11       DO KILL^AUPNPAT

 +12       DO ^XBFMK

 +13       LOCK -^BGPDATA

 +14       QUIT 

 +15      ;

ENDLOG    ;-- UPDATE LOG AT END

 +1        SET DIE="^BGPGUIJ("

           SET DA=BGPGIEN

           SET DR=".04////"_$$NOW^XLFDT_";.06///C"

 +2        DO ^DIE

 +3        KILL DIE,DR,DA

 +4        QUIT