Routine: BGP3GCMP

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

 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

TESTCMP ;

 S ERR=""

 D EP(.ERR,1,2522,"BGP 13 COMPREHENSIVE PAT LIST","A",,,1,3050000,338,"B",$$NOW^XLFDT)

 W !,ERR

EP(BGPRET,BGPUSER,BGPDUZ2,BGPOPTN,BGPLIST,BGPLPRV,BGPLPROV,BGPQTR,BGPPER,BGPTAXI,BGPROT,BGPRTIME,BGPMFITI,BGPVDT,BGPBEN,BGPFILE) ;EP - called from GUI to produce national gpra report (NTL-GP)

 ;  BGPUSER - DUZ

 ;  BGPDUZ2 - DUZ(2)

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

 ;  BGPLIST - this contains the answer to the following DIR call:

 ;        Select one of the following:

 ;         R         Random Patient List

 ;         P         Patient List by Provider

 ;         A         All Patients

 ;        Choose report type for the Lists: R//

 ;  BGPLPRV - will equal ien of provider if they picked "P" above

 ;  BGPLPROV - will equal provider name if they picked "P" above

 ;  BGPQTR - this is equal to 1,2,3,4 or 5 depending on how the user answers the following

 ;           DIR call:

 ;               Select one of the following:

 ;         1         January 1 - December 31

 ;         2         April 1 - March 31

 ;         3         July 1 - June 30

 ;         4         October 1 - September 30

 ;         5         User-Defined Report Period

 ;       Enter the date range for your report:

 ;  BGPPER - this is the year they select if they answered the above question

 ;           with a 1 through 4  e.g  3060000 (fileman imprecise date for 2010)

 ;           If they chose 5 then this would be the end date they entered, e.g.

 ;           3050301

 ;  BGPTAXI - IEN OF COMMUNITY TAXONOMY NAME

 ;  BGPROT - type of output  P for printed, D For Delimited, B for both

 ;  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

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

 I $G(BGPTAXI)="" S BGPRET=0_"^IEN OF COMMUNITY TAXONOMY NOT PASSED" Q

 I '$D(^ATXAX(BGPTAXI)) S BGPRET=0_"^INVALID COMMUNITY TAXONOMY IEN PASSED" Q

 I $G(BGPPER)="" S BGPRET=0_"^YEAR VARIABLE NOT PASSED" Q

 I $G(BGPQTR)="" S BGPRET=0_"^QUARTER/DATE TYPE NOT PASSED" Q

 I "PDB"'[$G(BGPROT) S BGPRET=0_"^REPORT OUTPUT TYPE NOT PASSED" Q

 I $G(BGPLIST)="" S BGPRET=0_"^LIST TYPE NOT PASSED" Q

 I $G(BGPLIST)="P",$G(BGPLPRV)="" S BGPRET=0_"^PROVIDER NOT PASSED FOR LIST TYPE P" Q

 I $G(BGPVDT)="" S BGPRET=0_"^BASELINE YEAR NOT PASSED" Q

 I $G(BGPBEN)="" S BGPRET=0_"^BENEFICIARY TYPE 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 BGPRTYPE=1,BGPYRPTH="",BGPCPPL=1,BGPINDH="G",BGPYGPU=1

 K BGPTAX S X=0

 F  S X=$O(^ATXAX(BGPTAXI,21,X)) Q:'X  D

 .S BGPTAX($P(^ATXAX(BGPTAXI,21,X,0),U))=""

.Q

 I BGPQTR=1 S BGPBD=$E(BGPPER,1,3)_"0101",BGPED=$E(BGPPER,1,3)_"1231"

 I BGPQTR=2 S BGPBD=($E(BGPPER,1,3)-1)_"0401",BGPED=$E(BGPPER,1,3)_"0331"

 I BGPQTR=3 S BGPBD=($E(BGPPER,1,3)-1)_"0701",BGPED=$E(BGPPER,1,3)_"0630"

 I BGPQTR=4 S BGPBD=($E(BGPPER,1,3)-1)_"1001",BGPED=$E(BGPPER,1,3)_"0930"

 I BGPQTR=5 S BGPBD=$$FMADD^XLFDT(BGPPER,-364),BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"

BY ;get baseline year

 ;S BGPVDT=3000000

 S X=$E(BGPPER,1,3)-$E(BGPVDT,1,3)

 S X=X_"0000"

 S BGPBBD=BGPBD-X,BGPBBD=$E(BGPBBD,1,3)_$E(BGPBD,4,7)

 S BGPBED=BGPED-X,BGPBED=$E(BGPBED,1,3)_$E(BGPED,4,7)

 S BGPPBD=($E(BGPBD,1,3)-1)_$E(BGPBD,4,7)

 S BGPPED=($E(BGPED,1,3)-1)_$E(BGPED,4,7)

 ;S BGPBEN=1

 K BGPTAX S X=0

 F  S X=$O(^ATXAX(BGPTAXI,21,X)) Q:'X  D

 .S BGPTAX($P(^ATXAX(BGPTAXI,21,X,0),U))=""

.Q

 S BGPHOME=$P($G(^BGPSITE(DUZ(2),0)),U,2)

 S X=0 F  S X=$O(^BGPINDH("GPRA",1,X)) Q:X'=+X  S BGPIND(X)=""

 S BGPINDH="G"

 D REPORT^BGP3UTL

 I $G(BGPQUIT) S BGPRET=0_"^COULD NOT CREATE REPORT ENTRY" Q

 I BGPRPT="" S BGPRET=0_"^COULD NOT CREATE REPORT ENTRY" Q

 S BGPDELT=""

 ;create entry in GUI file

 D ^XBFMK

 ;S X=BGPUSER_$$NOW^XLFDT

 S X=BGPFILE

 S BGPGFNM=X

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

 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

TSKMN ;

 S ZTIO=""

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

 S ZTCPU=$G(IOCPU),ZTRTN="NTLCMP^BGP3GCMP",ZTDTH=$S(BGPRTIME]"":BGPRTIME,1:$$NOW^XLFDT),ZTDESC="GUI COMPREHENSIVE PATIENT LIST 09" D ^%ZTLOAD Q

NTLCMP ;

 S BGPCPLC=0

 D ^BGP3D1

 K ^TMP($J,"BGPGUI")

 S IOM=80,BGPIOSL=55

 D GUIR^BGPXBLM("^BGP3DP","^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 ^BGPGUIH(BGPGIEN,11,C,0)=BGPDATA

 S ^BGPGUIH(BGPGIEN,11,0)="^90549.1911^"_C_"^"_C_"^"_DT

 K ^TMP($J,"BGPGUI")

 D ENDLOG

 D XIT

XIT ;

 K ^TMP($J)

 D EN^XBVK("BGP") 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

ENDLOG ;-- UPDATE LOG AT END

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

 D ^DIE

 K DIE,DR,DA

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

 +1       ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

 +2       ;

 +3       ;

TESTCMP   ;

 +1        SET ERR=""

 +2        DO EP(.ERR,1,2522,"BGP 13 COMPREHENSIVE PAT LIST","A",,,1,3050000,338,"B",$$NOW^XLFDT)

 +3        WRITE !,ERR

 +4        QUIT

EP(BGPRET,BGPUSER,BGPDUZ2,BGPOPTN,BGPLIST,BGPLPRV,BGPLPROV,BGPQTR,BGPPER,BGPTAXI,BGPROT,BGPRTIME,BGPMFITI,BGPVDT,BGPBEN,BGPFILE) ;EP - called from GUI to produce national gpra report (NTL-GP)

 +1       ;  BGPUSER - DUZ

 +2       ;  BGPDUZ2 - DUZ(2)

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

 +4       ;

 +5       ;  BGPLIST - this contains the answer to the following DIR call:

 +6       ;

 +7       ;        Select one of the following:

 +8       ;         R         Random Patient List

 +9       ;         P         Patient List by Provider

 +10      ;         A         All Patients

 +11      ;

 +12      ;        Choose report type for the Lists: R//

 +13      ;

 +14      ;  BGPLPRV - will equal ien of provider if they picked "P" above

 +15      ;  BGPLPROV - will equal provider name if they picked "P" above

 +16      ;

 +17      ;  BGPQTR - this is equal to 1,2,3,4 or 5 depending on how the user answers the following

 +18      ;           DIR call:

 +19      ;               Select one of the following:

 +20      ;

 +21      ;         1         January 1 - December 31

 +22      ;         2         April 1 - March 31

 +23      ;         3         July 1 - June 30

 +24      ;         4         October 1 - September 30

 +25      ;         5         User-Defined Report Period

 +26      ;       Enter the date range for your report:

 +27      ;

 +28      ;  BGPPER - this is the year they select if they answered the above question

 +29      ;           with a 1 through 4  e.g  3060000 (fileman imprecise date for 2010)

 +30      ;           If they chose 5 then this would be the end date they entered, e.g.

 +31      ;           3050301

 +32      ;

 +33      ;  BGPTAXI - IEN OF COMMUNITY TAXONOMY NAME

 +34      ;  BGPROT - type of output  P for printed, D For Delimited, B for both

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

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

 +37      ;             must be date and time

 +38      ;

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

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

 +41      ;  if they chose to export to area

 +42      ;

 +43      ;create entry in gui output file

 +44      ;queue report to run with/GUIR

 +45       DO EP1

 +46       SET Y=BGPRET

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

 +48       SET BGPRET=Y

 +49       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        IF $GET(BGPTAXI)=""

               SET BGPRET=0_"^IEN OF COMMUNITY TAXONOMY NOT PASSED"

               QUIT

 +6        IF '$DATA(^ATXAX(BGPTAXI))

               SET BGPRET=0_"^INVALID COMMUNITY TAXONOMY IEN PASSED"

               QUIT

 +7        IF $GET(BGPPER)=""

               SET BGPRET=0_"^YEAR VARIABLE NOT PASSED"

               QUIT

 +8        IF $GET(BGPQTR)=""

               SET BGPRET=0_"^QUARTER/DATE TYPE NOT PASSED"

               QUIT

 +9        IF "PDB"'[$GET(BGPROT)

               SET BGPRET=0_"^REPORT OUTPUT TYPE NOT PASSED"

               QUIT

 +10       IF $GET(BGPLIST)=""

               SET BGPRET=0_"^LIST TYPE NOT PASSED"

               QUIT

 +11       IF $GET(BGPLIST)="P"

               IF $GET(BGPLPRV)=""

                   SET BGPRET=0_"^PROVIDER NOT PASSED FOR LIST TYPE P"

                   QUIT

 +12       IF $GET(BGPVDT)=""

               SET BGPRET=0_"^BASELINE YEAR NOT PASSED"

               QUIT

 +13       IF $GET(BGPBEN)=""

               SET BGPRET=0_"^BENEFICIARY TYPE NOT PASSED"

               QUIT

 +14       SET BGPRTIME=$GET(BGPRTIME)

 +15      ;S DUZ=BGPUSER

 +16       SET DUZ(2)=BGPDUZ2

 +17       IF '$DATA(DT)

               SET DT=$$DT^XLFDT

 +18       DO ^XBKVAR

 +19       SET BGPGUI=1

 +20       SET IOM=80

           SET BGPIOSL=55

 +21       SET BGPRTYPE=1

           SET BGPYRPTH=""

           SET BGPCPPL=1

           SET BGPINDH="G"

           SET BGPYGPU=1

 +22       KILL BGPTAX

           SET X=0

 +23       FOR

               SET X=$ORDER(^ATXAX(BGPTAXI,21,X))

               IF 'X

                   QUIT

               Begin DoDot:1

 +24               SET BGPTAX($PIECE(^ATXAX(BGPTAXI,21,X,0),U))=""

 +25               QUIT

               End DoDot:1

 +26       IF BGPQTR=1

               SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"

 +27       IF BGPQTR=2

               SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0401"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0331"

 +28       IF BGPQTR=3

               SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0701"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0630"

 +29       IF BGPQTR=4

               SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"1001"

               SET BGPED=$EXTRACT(BGPPER,1,3)_"0930"

 +30       IF BGPQTR=5

               SET BGPBD=$$FMADD^XLFDT(BGPPER,-364)

               SET BGPED=BGPPER

               SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"

BY        ;get baseline year

 +1       ;S BGPVDT=3000000

 +2        SET X=$EXTRACT(BGPPER,1,3)-$EXTRACT(BGPVDT,1,3)

 +3        SET X=X_"0000"

 +4        SET BGPBBD=BGPBD-X

           SET BGPBBD=$EXTRACT(BGPBBD,1,3)_$EXTRACT(BGPBD,4,7)

 +5        SET BGPBED=BGPED-X

           SET BGPBED=$EXTRACT(BGPBED,1,3)_$EXTRACT(BGPED,4,7)

 +6        SET BGPPBD=($EXTRACT(BGPBD,1,3)-1)_$EXTRACT(BGPBD,4,7)

 +7        SET BGPPED=($EXTRACT(BGPED,1,3)-1)_$EXTRACT(BGPED,4,7)

 +8       ;S BGPBEN=1

 +9        KILL BGPTAX

           SET X=0

 +10       FOR

               SET X=$ORDER(^ATXAX(BGPTAXI,21,X))

               IF 'X

                   QUIT

               Begin DoDot:1

 +11               SET BGPTAX($PIECE(^ATXAX(BGPTAXI,21,X,0),U))=""

 +12               QUIT

               End DoDot:1

 +13       SET BGPHOME=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,2)

 +14       SET X=0

FOR

               SET X=$ORDER(^BGPINDH("GPRA",1,X))

               IF X'=+X

                   QUIT

               SET BGPIND(X)=""

 +15       SET BGPINDH="G"

 +16       DO REPORT^BGP3UTL

 +17       IF $GET(BGPQUIT)

               SET BGPRET=0_"^COULD NOT CREATE REPORT ENTRY"

               QUIT

 +18       IF BGPRPT=""

               SET BGPRET=0_"^COULD NOT CREATE REPORT ENTRY"

               QUIT

 +19       SET BGPDELT=""

 +20      ;create entry in GUI file

 +21       DO ^XBFMK

 +22      ;S X=BGPUSER_$$NOW^XLFDT

 +23       SET X=BGPFILE

 +24       SET BGPGFNM=X

 +25       SET DIC="^BGPGUIH("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=90549.19

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

 +26       KILL DD,D0,DO

           DO FILE^DICN

           KILL DLAYGO,DIADD,DD,D0,DO

 +27       IF Y=-1

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

               QUIT

 +28       SET BGPGIEN=+Y

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

 +30       DO TSKMN

 +31       SET BGPRET=BGPGIEN

 +32       QUIT

 +33      ;

TSKMN     ;

 +1        SET ZTIO=""

 +2        KILL ZTSAVE

           SET ZTSAVE("*")=""

 +3        SET ZTCPU=$GET(IOCPU)

           SET ZTRTN="NTLCMP^BGP3GCMP"

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

           SET ZTDESC="GUI COMPREHENSIVE PATIENT LIST 09"

           DO ^%ZTLOAD

           QUIT

 +4        QUIT

NTLCMP    ;

 +1        SET BGPCPLC=0

 +2        DO ^BGP3D1

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

 +4        SET IOM=80

           SET BGPIOSL=55

 +5        DO GUIR^BGPXBLM("^BGP3DP","^TMP($J,""BGPGUI"",")

 +6        SET X=0

           SET C=0

FOR

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

               IF X'=+X

                   QUIT

               Begin DoDot:1

 +7                SET C=C+1

 +8                NEW BGPDATA

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

 +10               IF BGPDATA="ZZZZZZZ"

                       SET BGPDATA=$CHAR(12)

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

               End DoDot:1

 +12       SET ^BGPGUIH(BGPGIEN,11,0)="^90549.1911^"_C_"^"_C_"^"_DT

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

 +14       DO ENDLOG

 +15       DO XIT

 +16       QUIT

 +17      ;

XIT       ;

 +1        KILL ^TMP($JOB)

 +2        DO EN^XBVK("BGP")

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        KILL DIRUT,DUOUT,DIR,DOD

 +4        KILL DIADD,DLAYGO

 +5        DO KILL^AUPNPAT

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

 +7        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

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

 +9        KILL BD,ED

 +10       DO KILL^AUPNPAT

 +11       DO ^XBFMK

 +12       LOCK -^BGPDATA

 +13       QUIT

 +14      ;

ENDLOG    ;-- UPDATE LOG AT END

 +1        SET DIE="^BGPGUIH("

           SET DA=BGPGIEN

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

 +2        DO ^DIE

 +3        KILL DIE,DR,DA

 +4        QUIT

BGP3GCMP.m