Routine: BGP4GFO9

BGP4GFO9 ; IHS/CMI/LAB - GUI Patient Forecast Report ;

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

EP(BGPRET,BGPUSER,BGPDUZ2,BGPOPTN,BGPRT1,BGPDIVI,BGPABD,BGPAED,BGPCLN,BGPPATS,BGPRTIME,BGPFILE) ;EP - called from GUI to produce national GPU report (OTH-GPU)

 ;  BGPUSER - DUZ

 ;  BGPDUZ2 - DUZ(2)

 ;  BGPOPTN - OPTION NAME

 ;  BGPLST - Type of Sort Selected

 ;  BGPDIV - Medical Center Division

 ;  BGPBDT - Appointment Begin Date

 ;  BGPEDT - Appointment End Date

 ;  BGPCLN - Clinic List

 ;  BGPPAT - Patient List

 ;  BGPPATI - Individual Patient

 ;  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(BGPLST)="" S BGPRET=0_"^TYPE OF LIST 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="",BGPYGPU=1,BGPALLPT=1,BGPBEN=3

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

 S BGPINDJ="G"

 S BGPEXCEL=""

 S BGPUF=$$GETDIR^BGP4UTL2()

 ;I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["NT")!($P($G(^AUTTSITE(1,0)),U,21)=2) S BGPUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")

 ;I $P(^AUTTSITE(1,0),U,21)=1 S BGPUF="/usr/spool/uucppublic/" ;AI ;gather all gpra measures

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

 S X=$O(^BGPCTRL("B",2014,0))

 S Y=^BGPCTRL(X,0)

 S BGPBD=$P(Y,U,8),BGPED=$P(Y,U,9)

 S BGPPBD=$P(Y,U,10),BGPPED=$P(Y,U,11)

 S BGPBBD=$P(Y,U,12),BGPBED=$P(Y,U,13)

 S BGPPER=$P(Y,U,14),BGPQTR=3

 ;ADDED FOR 09 REPORT

 S BGPBD=3130701,BGPED=3140630

 S BGPPBD=3110701,BGPPBD=3120630

 S BGPPER=3120000

 S BGPNGR09=1

 S BGPLIST="A"

 S BGPCPLC=0

 S BGPROT="P"  ;output type

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

 ;create entry in GUI file

 D ^XBFMK

 S X=BGPFILE

 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///"_$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="GUIP^BGP4GFO9",ZTDTH=$S(BGPRTIME]"":BGPRTIME,1:$$NOW^XLFDT),ZTDESC="GUI FORECAST 09 FOR 09" D ^%ZTLOAD Q

GUIP ;

 D PROC^BGP4DPA9

 K ^TMP($J,"BGP4DPA")

 S IOM=80,BGPIOSL=55

 D GUIR^BGPXBLM("PRINT^BGP4DPAW","^TMP($J,""BGP4DPA"",")

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

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

 . S C=C+1

 . N BGPDATA

 . S BGPDATA=$G(^TMP($J,"BGP4DPA",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,"BGP4DPA")

 ;cmi/anch/maw end of mods

 D ENDLOG

 D XIT

XIT ;

 K ^TMP($J)

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

 D ^DIE

 K DIE,DR,DA

BGP4GFO9  ; IHS/CMI/LAB - GUI Patient Forecast Report ;

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

 +2       ;

 +3       ;

EP(BGPRET,BGPUSER,BGPDUZ2,BGPOPTN,BGPRT1,BGPDIVI,BGPABD,BGPAED,BGPCLN,BGPPATS,BGPRTIME,BGPFILE) ;EP - called from GUI to produce national GPU report (OTH-GPU)

 +1       ;  BGPUSER - DUZ

 +2       ;  BGPDUZ2 - DUZ(2)

 +3       ;  BGPOPTN - OPTION NAME

 +4       ;  BGPLST - Type of Sort Selected

 +5       ;

 +6       ;  BGPDIV - Medical Center Division

 +7       ;  BGPBDT - Appointment Begin Date

 +8       ;  BGPEDT - Appointment End Date

 +9       ;  BGPCLN - Clinic List

 +10      ;  BGPPAT - Patient List

 +11      ;  BGPPATI - Individual Patient

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

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

 +14      ;             must be date and time

 +15      ;

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

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

 +18      ;  if they chose to export to area

 +19      ;

 +20      ;create entry in gui output file

 +21      ;queue report to run with/GUIR

 +22       DO EP1

 +23       SET Y=BGPRET

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

 +25       SET BGPRET=Y

 +26       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(BGPLST)=""

               SET BGPRET=0_"^TYPE OF LIST 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       SET BGPRTYPE=1

           SET BGPYRPTH=""

           SET BGPYGPU=1

           SET BGPALLPT=1

           SET BGPBEN=3

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

 +15       SET BGPINDJ="G"

 +16       SET BGPEXCEL=""

 +17       SET BGPUF=$$GETDIR^BGP4UTL2()

 +18      ;I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["NT")!($P($G(^AUTTSITE(1,0)),U,21)=2) S BGPUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")

 +19      ;I $P(^AUTTSITE(1,0),U,21)=1 S BGPUF="/usr/spool/uucppublic/" ;AI ;gather all gpra measures

 +20       SET X=0

FOR

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

               IF X'=+X

                   QUIT

               SET BGPIND(X)=""

 +21       SET X=$ORDER(^BGPCTRL("B",2014,0))

 +22       SET Y=^BGPCTRL(X,0)

 +23       SET BGPBD=$PIECE(Y,U,8)

           SET BGPED=$PIECE(Y,U,9)

 +24       SET BGPPBD=$PIECE(Y,U,10)

           SET BGPPED=$PIECE(Y,U,11)

 +25       SET BGPBBD=$PIECE(Y,U,12)

           SET BGPBED=$PIECE(Y,U,13)

 +26       SET BGPPER=$PIECE(Y,U,14)

           SET BGPQTR=3

 +27      ;ADDED FOR 09 REPORT

 +28       SET BGPBD=3130701

           SET BGPED=3140630

 +29       SET BGPPBD=3110701

           SET BGPPBD=3120630

 +30       SET BGPPER=3120000

 +31       SET BGPNGR09=1

 +32       SET BGPLIST="A"

 +33       SET BGPCPLC=0

 +34      ;output type

           SET BGPROT="P"

 +35       IF $GET(BGPQUIT)

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

               QUIT

 +36      ;create entry in GUI file

 +37       DO ^XBFMK

 +38       SET X=BGPFILE

 +39       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///"_$G(BGPROT)

 +40       KILL DD,D0,DO

           DO FILE^DICN

           KILL DLAYGO,DIADD,DD,D0,DO

 +41       IF Y=-1

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

               QUIT

 +42       SET BGPGIEN=+Y

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

 +44       DO TSKMN

 +45       SET BGPRET=BGPGIEN

 +46       QUIT

 +47      ;

TSKMN     ;

 +1        SET ZTIO=""

 +2        KILL ZTSAVE

           SET ZTSAVE("*")=""

 +3        SET ZTCPU=$GET(IOCPU)

           SET ZTRTN="GUIP^BGP4GFO9"

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

           SET ZTDESC="GUI FORECAST 09 FOR 09"

           DO ^%ZTLOAD

           QUIT

 +4        QUIT

GUIP      ;

 +1        DO PROC^BGP4DPA9

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

 +3        SET IOM=80

           SET BGPIOSL=55

 +4        DO GUIR^BGPXBLM("PRINT^BGP4DPAW","^TMP($J,""BGP4DPA"",")

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

 +6        SET X=0

           SET C=0

FOR

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

               IF X'=+X

                   QUIT

               Begin DoDot:1

 +7                SET C=C+1

 +8                NEW BGPDATA

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

 +10               IF BGPDATA="ZZZZZZZ"

                       SET BGPDATA=$CHAR(12)

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

               End DoDot:1

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

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

 +14      ;cmi/anch/maw end of mods

 +15       DO ENDLOG

 +16       DO XIT

 +17       QUIT

 +18      ;

XIT       ;

 +1        KILL ^TMP($JOB)

 +2        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="^BGPGUIJ("

           SET DA=BGPGIEN

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

 +2        DO ^DIE

 +3        KILL DIE,DR,DA

 +4        QUIT

BGP4GFO9.m