BGP2GLST.m

BGP2GLST ; IHS/CMI/LAB - GUI CMS REPORT ;

 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 ;

 ;

EP(BGPRET,BGPUSER,BGPDUZ2,BGPOPTN,BGPDIR,BGPRTIME) ;EP - called from GUI to produce LIST OF FILES

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

 ;  BGPUSER - DUZ

 ;  BGPDUZ2 - DUZ(2)

 ;  BGPOPTN - OPTION NAME

 ;  BGPDIR - directory to list

 ;

 ;

 ;  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

 ;

 ;  I put the list of files in the BGPGUIW global in field 1100 as an output

 ;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(BGPDIR)="" S BGPRET=0_"^DIRECTORY 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

 ;create entry in GUI file

 D ^XBFMK

 S X=BGPUSER_$$NOW^XLFDT

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

 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="AOLST^BGP2GLST",ZTDTH=$S(BGPRTIME]"":BGPRTIME,1:$$NOW^XLFDT),ZTDESC="GUI 06 UPLOAD FILE LIST" D ^%ZTLOAD Q

 Q

AOLST ;

 K BGPLIST S BGPLIST="",X=$$LIST^%ZISH(BGPDIR,"BG121*",.BGPLIST)

 I $O(BGPLIST(""))="" S ^BGPGUIW(BGPGIEN,11,C,0)="There are no files in that directory." D ENDLOG,XIT Q

 S X=0,C=0 F  S X=$O(BGPLIST(X)) Q:X'=+X  S C=C+1,^BGPGUIW(BGPGIEN,11,C,0)=BGPLIST(X)

 S ^BGPGUIW(BGPGIEN,11,0)="^90546.1911^"_C_"^"_C_"^"_DT

 K ^TMP($J,"BGPGUI")

 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="^BGPGUIW(",DA=BGPGIEN,DR=".04////"_$$NOW^XLFDT_";.06///C"

 D ^DIE

 K DIE,DR,DA

 Q

BGP2GLST  ; IHS/CMI/LAB - GUI CMS REPORT ;

 +1       ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 +2       ;

 +3       ;

EP(BGPRET,BGPUSER,BGPDUZ2,BGPOPTN,BGPDIR,BGPRTIME) ;EP - called from GUI to produce LIST OF FILES

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

 +2       ;  BGPUSER - DUZ

 +3       ;  BGPDUZ2 - DUZ(2)

 +4       ;  BGPOPTN - OPTION NAME

 +5       ;  BGPDIR - directory to list

 +6       ;

 +7       ;

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

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

 +10      ;  if they chose to export to area

 +11      ;

 +12      ;  I put the list of files in the BGPGUIW global in field 1100 as an output

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

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

               QUIT 

 +6        SET BGPRTIME=$GET(BGPRTIME)

 +7       ;S DUZ=BGPUSER

 +8        SET DUZ(2)=BGPDUZ2

 +9        IF '$DATA(DT)

               SET DT=$$DT^XLFDT

 +10       DO ^XBKVAR

 +11       SET BGPGUI=1

 +12       SET IOM=80

           SET BGPIOSL=55

 +13      ;create entry in GUI file

 +14       DO ^XBFMK

 +15       SET X=BGPUSER_$$NOW^XLFDT

 +16       SET DIC="^BGPGUIW("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=90546.19

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

 +17       KILL DD,D0,DO

           DO FILE^DICN

           KILL DLAYGO,DIADD,DD,D0,DO

 +18       IF Y=-1

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

               QUIT 

 +19       SET BGPGIEN=+Y

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

 +21       DO TSKMN

 +22       SET BGPRET=BGPGIEN

 +23       QUIT 

 +24      ;

TSKMN     ;

 +1        SET ZTIO=""

 +2        KILL ZTSAVE

           SET ZTSAVE("*")=""

 +3        SET ZTCPU=$GET(IOCPU)

           SET ZTRTN="AOLST^BGP2GLST"

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

           SET ZTDESC="GUI 06 UPLOAD FILE LIST"

           DO ^%ZTLOAD

           QUIT 

 +4        QUIT 

AOLST     ;

 +1        KILL BGPLIST

           SET BGPLIST=""

           SET X=$$LIST^%ZISH(BGPDIR,"BG121*",.BGPLIST)

 +2        IF $ORDER(BGPLIST(""))=""

               SET ^BGPGUIW(BGPGIEN,11,C,0)="There are no files in that directory."

               DO ENDLOG

               DO XIT

               QUIT 

 +3        SET X=0

           SET C=0

           FOR 

               SET X=$ORDER(BGPLIST(X))

               IF X'=+X

                   QUIT 

               SET C=C+1

               SET ^BGPGUIW(BGPGIEN,11,C,0)=BGPLIST(X)

 +4        SET ^BGPGUIW(BGPGIEN,11,0)="^90546.1911^"_C_"^"_C_"^"_DT

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

 +6        DO ENDLOG

 +7        DO XIT

 +8        QUIT 

 +9       ;

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="^BGPGUIW("

           SET DA=BGPGIEN

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

 +2        DO ^DIE

 +3        KILL DIE,DR,DA

 +4        QUIT