BGP0GCMS.m

BGP0GCMS ; IHS/CMI/LAB - GUI CMS REPORT 27 Apr 2009 10:30 PM ;

 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010

 ;

 ;

TESTNTL ;

 S ERR=""

 F X=1:1:3 S BGPND(X)=""

 D EP(.ERR,1,2522,"BGP 10 CMS PERF RPT",2522,.BGPND,1,3020000,$$NOW^XLFDT)

 W !,ERR

 Q

EP(BGPRET,BGPUSER,BGPDUZ2,BGPOPTN,BGPHOSP,BGPIND,BGPPLSTL,BGPQTR,BGPPER,BGPRTIME,BGPUDBD,BGPED,BGPBEN,BGPTEXD,BGPFILE) ;EP - called from GUI to produce COM REPORT CI05-RPT-LOC-CMS

 ; SEE ROUTINE BGP0DC if you have questions about any of these variables

 ;  BGPUSER - DUZ

 ;  BGPDUZ2 - DUZ(2)

 ;  BGPOPTN - OPTION NAME

 ;  BGPHOSP - IEN OF HOSPITAL FROM LOCATION FILE

 ;

 ;  BGPIND - array of iens from items selected from ^BGPCMSIT GLOBAL

 ;

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

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

 ;  if they chose to export to area

 ;

 ;  BGPQTR - this is 1,2,3,4 for the quarter selectd

 ;  BGPPER - Internal fileman date for the year e.g. 3040000

 ;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

 I $G(BGPHOSP)="" S BGPRET=0_"^HOSPITAL IEN NOT PASSED" Q

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

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

 I '$D(BGPIND) S BGPRET=0_"^INDICATOR ARRAY 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

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

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

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

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

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

 I BGPQTR=5 S BGPBD=BGPUDBD,BGPPER=$E(BGPED,1,3)_"0000"

 ;create entry in GUI file

 D ^XBFMK

 S X=BGPFILE

 ;S X=BGPUSER_$$NOW^XLFDT

 S BGPGFNM=X

 S DIC="^BGPGUIT(",DIC(0)="L",DIADD=1,DLAYGO=90378.08,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="LOCCMS^BGP0GCMS",ZTDTH=$S(BGPRTIME]"":BGPRTIME,1:$$NOW^XLFDT),ZTDESC="GUI 09 CMS LIST" D ^%ZTLOAD Q

 Q

LOCCMS ;

 D ^BGP0C1

 K ^TMP($J,"BGPGUI")

 S IOM=80,BGPIOSL=55

 D GUIR^XBLM("^BGP0CP","^TMP($J,""BGPGUI"",")

 ;cmi/anch/maw added 5/12/2008 for word output

 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 ^BGPGUIT(BGPGIEN,11,C,0)=BGPDATA

 S ^BGPGUIT(BGPGIEN,11,0)="^90378.0811^"_C_"^"_C_"^"_DT

 K ^TMP($J,"BGPGUI")

 ;cmi/anch/maw end of mods

 D ENDLOG

 D XIT

 Q

 ;

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

 Q

ENDLOG ;-- UPDATE LOG AT END

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

 D ^DIE

 K DIE,DR,DA

 Q

BGP0GCMS  ; IHS/CMI/LAB - GUI CMS REPORT 27 Apr 2009 10:30 PM ;

 +1       ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010

 +2       ;

 +3       ;

TESTNTL   ;

 +1        SET ERR=""

 +2        FOR X=1:1:3

               SET BGPND(X)=""

 +3        DO EP(.ERR,1,2522,"BGP 10 CMS PERF RPT",2522,.BGPND,1,3020000,$$NOW^XLFDT)

 +4        WRITE !,ERR

 +5        QUIT 

EP(BGPRET,BGPUSER,BGPDUZ2,BGPOPTN,BGPHOSP,BGPIND,BGPPLSTL,BGPQTR,BGPPER,BGPRTIME,BGPUDBD,BGPED,BGPBEN,BGPTEXD,BGPFILE) ;EP - called from GUI to produce COM REPORT CI05-RPT-LOC-CMS

 +1       ; SEE ROUTINE BGP0DC if you have questions about any of these variables

 +2       ;  BGPUSER - DUZ

 +3       ;  BGPDUZ2 - DUZ(2)

 +4       ;  BGPOPTN - OPTION NAME

 +5       ;  BGPHOSP - IEN OF HOSPITAL FROM LOCATION FILE

 +6       ;

 +7       ;  BGPIND - array of iens from items selected from ^BGPCMSIT GLOBAL

 +8       ;

 +9       ;  BGPRET - return value is ien^error message. 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      ;  BGPQTR - this is 1,2,3,4 for the quarter selectd

 +14      ;  BGPPER - Internal fileman date for the year e.g. 3040000

 +15      ;create entry in gui output file

 +16      ;queue report to run with/GUIR

 +17       DO EP1

 +18       SET Y=BGPRET

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

 +20       SET BGPRET=Y

 +21       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(BGPHOSP)=""

               SET BGPRET=0_"^HOSPITAL IEN NOT PASSED"

               QUIT 

 +6        IF $GET(BGPPER)=""

               SET BGPRET=0_"^YEAR NOT PASSED"

               QUIT 

 +7        IF $GET(BGPQTR)=""

               SET BGPRET=0_"^QUARTER NOT PASSED"

               QUIT 

 +8        IF '$DATA(BGPIND)

               SET BGPRET=0_"^INDICATOR ARRAY NOT PASSED"

               QUIT 

 +9        SET BGPRTIME=$GET(BGPRTIME)

 +10      ;S DUZ=BGPUSER

 +11       SET DUZ(2)=BGPDUZ2

 +12       IF '$DATA(DT)

               SET DT=$$DT^XLFDT

 +13       DO ^XBKVAR

 +14       SET BGPGUI=1

 +15       SET IOM=80

           SET BGPIOSL=55

 +16       IF BGPQTR=1

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

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

 +17       IF BGPQTR=2

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

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

 +18       IF BGPQTR=3

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

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

 +19       IF BGPQTR=4

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

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

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

 +21       IF BGPQTR=5

               SET BGPBD=BGPUDBD

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

 +22      ;create entry in GUI file

 +23       DO ^XBFMK

 +24       SET X=BGPFILE

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

 +26       SET BGPGFNM=X

 +27       SET DIC="^BGPGUIT("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=90378.08

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

 +28       KILL DD,D0,DO

           DO FILE^DICN

           KILL DLAYGO,DIADD,DD,D0,DO

 +29       IF Y=-1

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

               QUIT 

 +30       SET BGPGIEN=+Y

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

 +32       DO TSKMN

 +33       SET BGPRET=BGPGIEN

 +34       QUIT 

 +35      ;

TSKMN     ;

 +1        SET ZTIO=""

 +2        KILL ZTSAVE

           SET ZTSAVE("*")=""

 +3        SET ZTCPU=$GET(IOCPU)

           SET ZTRTN="LOCCMS^BGP0GCMS"

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

           SET ZTDESC="GUI 09 CMS LIST"

           DO ^%ZTLOAD

           QUIT 

 +4        QUIT 

LOCCMS    ;

 +1        DO ^BGP0C1

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

 +3        SET IOM=80

           SET BGPIOSL=55

 +4        DO GUIR^XBLM("^BGP0CP","^TMP($J,""BGPGUI"",")

 +5       ;cmi/anch/maw added 5/12/2008 for word output

 +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 ^BGPGUIT(BGPGIEN,11,C,0)=BGPDATA

               End DoDot:1

 +12       SET ^BGPGUIT(BGPGIEN,11,0)="^90378.0811^"_C_"^"_C_"^"_DT

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

 +14      ;cmi/anch/maw end of mods

 +15       DO ENDLOG

 +16       DO XIT

 +17       QUIT 

 +18      ;

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 

ENDLOG    ;-- UPDATE LOG AT END

 +1        SET DIE="^BGPGUIT("

           SET DA=BGPGIEN

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

 +2        DO ^DIE

 +3        KILL DIE,DR,DA

 +4        QUIT