BGP8LHW.m

BGP8LHW ; IHS/CMI/LAB - CRS 27 Apr 2010 10:56 PM 13 Dec 2006 7:35 AM ;

 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 ;

 ;

TESTNTL ;

 S ERR=""

 D EP(.ERR,1,2582,"BGP 18 LOCAL HT/WT",597,0,"B",$$NOW^XLFDT,,0)

 W !,ERR

 Q

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

 ;  BGPUSER - DUZ

 ;  BGPDUZ2 - DUZ(2)

 ;  BGPOPTN - OPTION NAME

 ;  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

 ;  BGPONEF - one or multiple files of height/weight

 ;  BGPFN - printed output filename

 ;

 ;  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

 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 "PDB"'[$G(BGPROT) S BGPRET=0_"^REPORT OUTPUT TYPE NOT PASSED" Q

 S BGPRTIME=$G(BGPRTIME)

 S BGPFILE=$G(BGPFILE)

 S BGPONEF=$G(BGPONEF) I BGPONEF="" S BGPRET=0_"^one or multiple not passed" Q

 ;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=""

 S X=$O(^BGPCTRL("B",2018,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=4

 S BGPBEN=1

 G NT

 S BGPBD=3151001,BGPED=3160930

 S BGPBBD=3100101,BGPBED=3101231

 S BGPPBD=3120101,BGPPED=3121231

 S BGPPER=3030000,BGPQTR=3,BGPBEN=1

NT ;

 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(^BGPINDR("GPRA",1,X)) Q:X'=+X  S BGPIND(X)=""

 S BGPINDG="G",BGPHWNOW=$$NOW^XLFDT

 S BGPEXCEL=""

 I BGPYWCHW="",BGPEXPT S BGPYWCHW=0  ;$S($P($G(^BGPSITE(DUZ(2),0)),U,11)=0:0,1:1)  LAB/V13

 S BGPUF=$$GETDIR^BGP8UTL2()

 D REPORT^BGP8UTL

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

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

 ;create entry in GUI file

 D ^XBFMK

 ;S X=BGPUSER_$$NOW^XLFDT

 S X=BGPFILE

 S BGPGFNM=X

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

 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

 I BGPEXPT S $P(BGPRET,U,3)=BGPFILEN

 I BGPYWCHW=2 S $P(BGPRET,U,4)=BGPFN

 Q

 ;

TSKMN ;

 S ZTIO=""

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

 S ZTCPU=$G(IOCPU),ZTRTN="NTLGP^BGP8LHW",ZTDTH=$S(BGPRTIME]"":BGPRTIME,1:$$NOW^XLFDT),ZTDESC="GUI LOCAL HT/WT FILE" D ^%ZTLOAD Q

 Q

NTLGP ;

 D ^BGP8D1

 K ^TMP($J,"BGPGUI")

 S IOM=80,BGPIOSL=55

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

 D GUIR^XBLM("^BGP8DP","^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 ^BGPGUIR(BGPGIEN,11,C,0)=BGPDATA

 S ^BGPGUIR(BGPGIEN,11,0)="^90560.1911^"_C_"^"_C_"^"_DT

 K ^TMP($J,"BGPGUI")

 ;cmi/anch/maw end of mods

 I BGPEXPT D GS^BGP8UTL

 ;I $G(BGPYWCHW)=2 D HWSF^BGP8DHW

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

 D ^DIE

 K DIE,DR,DA

 Q

BGP8LHW   ; IHS/CMI/LAB - CRS 27 Apr 2010 10:56 PM 13 Dec 2006 7:35 AM ;

 +1       ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 +2       ;

 +3       ;

TESTNTL   ;

 +1        SET ERR=""

 +2        DO EP(.ERR,1,2582,"BGP 18 LOCAL HT/WT",597,0,"B",$$NOW^XLFDT,,0)

 +3        WRITE !,ERR

 +4        QUIT 

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

 +1       ;  BGPUSER - DUZ

 +2       ;  BGPDUZ2 - DUZ(2)

 +3       ;  BGPOPTN - OPTION NAME

 +4       ;  BGPTAXI - IEN OF COMMUNITY TAXONOMY NAME

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

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

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

 +8       ;             must be date and time

 +9       ;  BGPONEF - one or multiple files of height/weight

 +10      ;  BGPFN - printed output filename

 +11      ;

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

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

 +14      ;  if they chose to export to area

 +15      ;

 +16      ;create entry in gui output file

 +17      ;queue report to run with/GUIR

 +18       DO EP1

 +19       SET Y=BGPRET

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

 +21       SET BGPRET=Y

 +22       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 "PDB"'[$GET(BGPROT)

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

               QUIT 

 +8        SET BGPRTIME=$GET(BGPRTIME)

 +9        SET BGPFILE=$GET(BGPFILE)

 +10       SET BGPONEF=$GET(BGPONEF)

           IF BGPONEF=""

               SET BGPRET=0_"^one or multiple not passed"

               QUIT 

 +11      ;S DUZ=BGPUSER

 +12       SET DUZ(2)=BGPDUZ2

 +13       IF '$DATA(DT)

               SET DT=$$DT^XLFDT

 +14       DO ^XBKVAR

 +15       SET BGPGUI=1

 +16       SET IOM=80

           SET BGPIOSL=55

 +17       SET BGPRTYPE=1

           SET BGPYRPTH=""

 +18       SET X=$ORDER(^BGPCTRL("B",2018,0))

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

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

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

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

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

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

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

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

           SET BGPQTR=4

 +24       SET BGPBEN=1

 +25       GOTO NT

 +26       SET BGPBD=3151001

           SET BGPED=3160930

 +27       SET BGPBBD=3100101

           SET BGPBED=3101231

 +28       SET BGPPBD=3120101

           SET BGPPED=3121231

 +29       SET BGPPER=3030000

           SET BGPQTR=3

           SET BGPBEN=1

NT        ;

 +1        KILL BGPTAX

           SET X=0

 +2        FOR 

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

               IF 'X

                   QUIT 

               Begin DoDot:1

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

 +4                QUIT 

               End DoDot:1

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

 +6        SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

               SET BGPIND(X)=""

 +7        SET BGPINDG="G"

           SET BGPHWNOW=$$NOW^XLFDT

 +8        SET BGPEXCEL=""

 +9       ;$S($P($G(^BGPSITE(DUZ(2),0)),U,11)=0:0,1:1)  LAB/V13

           IF BGPYWCHW=""

               IF BGPEXPT

                   SET BGPYWCHW=0

 +10       SET BGPUF=$$GETDIR^BGP8UTL2()

 +11       DO REPORT^BGP8UTL

 +12       IF $GET(BGPQUIT)

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

               QUIT 

 +13       IF BGPRPT=""

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

               QUIT 

 +14      ;create entry in GUI file

 +15       DO ^XBFMK

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

 +17       SET X=BGPFILE

 +18       SET BGPGFNM=X

 +19       SET DIC="^BGPGUIR("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=90560.19

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

 +20       KILL DD,D0,DO

           DO FILE^DICN

           KILL DLAYGO,DIADD,DD,D0,DO

 +21       IF Y=-1

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

               QUIT 

 +22       SET BGPGIEN=+Y

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

 +24       DO TSKMN

 +25       SET BGPRET=BGPGIEN

 +26       IF BGPEXPT

               SET $PIECE(BGPRET,U,3)=BGPFILEN

 +27       IF BGPYWCHW=2

               SET $PIECE(BGPRET,U,4)=BGPFN

 +28       QUIT 

 +29      ;

TSKMN     ;

 +1        SET ZTIO=""

 +2        KILL ZTSAVE

           SET ZTSAVE("*")=""

 +3        SET ZTCPU=$GET(IOCPU)

           SET ZTRTN="NTLGP^BGP8LHW"

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

           SET ZTDESC="GUI LOCAL HT/WT FILE"

           DO ^%ZTLOAD

           QUIT 

 +4        QUIT 

NTLGP     ;

 +1        DO ^BGP8D1

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

 +3        SET IOM=80

           SET BGPIOSL=55

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

 +5        DO GUIR^XBLM("^BGP8DP","^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 ^BGPGUIR(BGPGIEN,11,C,0)=BGPDATA

               End DoDot:1

 +12       SET ^BGPGUIR(BGPGIEN,11,0)="^90560.1911^"_C_"^"_C_"^"_DT

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

 +14      ;cmi/anch/maw end of mods

 +15       IF BGPEXPT

               DO GS^BGP8UTL

 +16      ;I $G(BGPYWCHW)=2 D HWSF^BGP8DHW

 +17       DO ENDLOG

 +18       DO XIT

 +19       QUIT 

 +20      ;

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

           SET DA=BGPGIEN

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

 +2        DO ^DIE

 +3        KILL DIE,DR,DA

 +4        QUIT