Routine: AGGRPRT

AGGRPRT ; VNGT/HS/KDC -  DAILY REGISTRATION ACTIVITY REPORT

 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010

 ; Copied from AGREPRT

EN(DATA,BDT,EDT,TYPE,AGGDUZ2) ; EP -- AGG DAILY REGISTRATION ACTIVITY REPORT

 ;Description

 ;  Generates DAILY REGISTRATION ACTIVITY REPORT

 ;Input

 ;  BDT - Beginning Date

 ;  EDT - Ending Date

 ;  TYPE - Type of daily report

 ;Output

 ;  DATA - Name of global in which data is stored(^TMP("AGGRPRT"))

 NEW UID,X,AGGI,HSTEXT,HSPATH,HSFN,Y,IOSL,IOST,IOM,I,N

 NEW AGBDT,AGBDTS,AGBM,AGTIME,AGUCI,AGBDTS,DFN

 NEW AG,AGB,AGE,AGIO,G,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTUCI ;,HDIR,HFN

 I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("AGGRPRT",UID))

 K @DATA

 S ROUTINE=$T(+0)

 S AGGI=0

 ;I $G(BDT)="" S BMXSEC="Must supply Beginning Date." G DONE

 ;I $G(EDT)="" S BMXSEC="Must supply End Date."  G DONE

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGRPRT D UNWIND^%ZTER"

 S BDT=$P($$DATE^AGGUL1(BDT),".")

 S EDT=$P($$DATE^AGGUL1(EDT),".")

 S IOSL=99999999999,IOM=80,IOST="P-OTHER80"

 S IOST(0)=$$FIND1^DIC(3.2,,"X",IOST)

 ;I BDT>DT S BMXSEC="Do not use future dates." G DONE

 ;I EDT>DT S BMXSEC="Do not use future dates." G DONE

 ;I BDT>EDT S BMXSEC="INVALID ENTRY - The END is before the BEGINNING." G DONE

 ;I ",1,2,3,4,"'[(","_TYPE_",") S BMXSEC="Please Enter only ""1"" ,""2"",""3"" or ""4""." G DONE

 S AG("TYPE")=TYPE

 S AG("B")=BDT

 S AG("E")=EDT

 S AGB=$$FMTE^XLFDT(AG("B"),5),AGE=$$FMTE^XLFDT(AG("E"),5)

 S AGIO=$G(IO),AG("HAT")=""

 D HDR

 I $$TMPFL^AGGUL1("W",UID,"AGG"_$J) G DONE

 ;S HDIR=$P(IO,"\",1,2)_"\",HFN=$P(IO,"\",3)

 U IO ;D ^AGREPRT1

 S AGBDT=AG("B")-.1,AG("FAC")=AGGDUZ2

 D ^AGPATCNT

 K DUOUT,DTOUT,DFOUT

 D NOW^AG S X="as of : "_AGTIME D CTR^AG S AGTIME=X

 I AG("TYPE")>2 D ^AGGRPRT2 G RET

 X ^%ZOSF("UCI") S X="UCI: "_$P(Y,",") D CTR^AG S AGUCI=X,X=$P(^DIC(4,AGGDUZ2,0),U) D CTR^AG S AG("LOC")=X,AG("USR")=$P(^VA(200,DUZ,0),U),AGBM=IOSL-10 I $D(AGIO),AGIO=IO S AGBM=IOSL-4

 S AGBDTS=AGBDT

 D SCAN^AGGRPRT1

 G:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) DONE

 D PRINT^AGGRPRT1

 ;D OPEN^%ZISH("AGGFILE",HDIR,HFN,"A")

RET ;

 U IO W $C(9)

 I $$TMPFL^AGGUL1("C") G DONE

 I $$TMPFL^AGGUL1("R",UID,"AGG"_$J) G DONE

 F  U IO R HSTEXT:.1 Q:HSTEXT[$C(9)  D  ;:$ZEOF=-1

 . S HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")

 . I HSTEXT="" S HSTEXT=" "

 . S AGGI=AGGI+1,@DATA@(AGGI)=HSTEXT_$C(13)_$C(10)_$C(30)

 S AGGI=AGGI+1,@DATA@(AGGI)=$C(30)

 I $$TMPFL^AGGUL1("C") G DONE

 I $$TMPFL^AGGUL1("D",UID,"AGG"_$J) G DONE

DONE ;

 S AGGI=AGGI+1,@DATA@(AGGI)=$C(31)

 K ROUTINE

HDR ;

 S @DATA@(AGGI)="T01024REPORT_TEXT"_$C(30)

ERR ;

 D ^%ZTER

 NEW Y,ERRDTM

 S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y

 S BMXSEC="Recording that an error occurred at "_ERRDTM

 I $D(AGGI),$D(DATA) S AGGI=AGGI+1,@DATA@(AGGI)=$C(31)

 I $$TMPFL^AGGUL1("C")

AGGRPRT   ; VNGT/HS/KDC -  DAILY REGISTRATION ACTIVITY REPORT

 +1       ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010

 +2       ;

 +3       ; Copied from AGREPRT

 +4       ;

 +5        QUIT

 +6       ;

EN(DATA,BDT,EDT,TYPE,AGGDUZ2) ; EP -- AGG DAILY REGISTRATION ACTIVITY REPORT

 +1       ;Description

 +2       ;  Generates DAILY REGISTRATION ACTIVITY REPORT

 +3       ;

 +4       ;Input

 +5       ;  BDT - Beginning Date

 +6       ;  EDT - Ending Date

 +7       ;  TYPE - Type of daily report

 +8       ;

 +9       ;Output

 +10      ;  DATA - Name of global in which data is stored(^TMP("AGGRPRT"))

 +11      ;

 +12       NEW UID,X,AGGI,HSTEXT,HSPATH,HSFN,Y,IOSL,IOST,IOM,I,N

 +13       NEW AGBDT,AGBDTS,AGBM,AGTIME,AGUCI,AGBDTS,DFN

 +14      ;,HDIR,HFN

           NEW AG,AGB,AGE,AGIO,G,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTUCI

 +15       IF '$DATA(DT)

               SET %DT=""

               SET X="T"

               DO ^%DT

               SET DT=Y

 +16       SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +17       SET DATA=$NAME(^TMP("AGGRPRT",UID))

 +18       KILL @DATA

 +19      ;

 +20       SET ROUTINE=$TEXT(+0)

 +21       SET AGGI=0

 +22      ;I $G(BDT)="" S BMXSEC="Must supply Beginning Date." G DONE

 +23      ;I $G(EDT)="" S BMXSEC="Must supply End Date."  G DONE

 +24      ;

 +25       NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^AGGRPRT D UNWIND^%ZTER"

 +26      ;

 +27       SET BDT=$PIECE($$DATE^AGGUL1(BDT),".")

 +28       SET EDT=$PIECE($$DATE^AGGUL1(EDT),".")

 +29       SET IOSL=99999999999

           SET IOM=80

           SET IOST="P-OTHER80"

 +30       SET IOST(0)=$$FIND1^DIC(3.2,,"X",IOST)

 +31      ;I BDT>DT S BMXSEC="Do not use future dates." G DONE

 +32      ;I EDT>DT S BMXSEC="Do not use future dates." G DONE

 +33      ;I BDT>EDT S BMXSEC="INVALID ENTRY - The END is before the BEGINNING." G DONE

 +34      ;I ",1,2,3,4,"'[(","_TYPE_",") S BMXSEC="Please Enter only ""1"" ,""2"",""3"" or ""4""." G DONE

 +35      ;

 +36       SET AG("TYPE")=TYPE

 +37       SET AG("B")=BDT

 +38       SET AG("E")=EDT

 +39       SET AGB=$$FMTE^XLFDT(AG("B"),5)

           SET AGE=$$FMTE^XLFDT(AG("E"),5)

 +40       SET AGIO=$GET(IO)

           SET AG("HAT")=""

 +41       DO HDR

 +42      ;

 +43       IF $$TMPFL^AGGUL1("W",UID,"AGG"_$JOB)

               GOTO DONE

 +44      ;

 +45      ;S HDIR=$P(IO,"\",1,2)_"\",HFN=$P(IO,"\",3)

 +46      ;D ^AGREPRT1

           USE IO

 +47       SET AGBDT=AG("B")-.1

           SET AG("FAC")=AGGDUZ2

 +48       DO ^AGPATCNT

 +49       KILL DUOUT,DTOUT,DFOUT

 +50       DO NOW^AG

           SET X="as of : "_AGTIME

           DO CTR^AG

           SET AGTIME=X

 +51       IF AG("TYPE")>2

               DO ^AGGRPRT2

               GOTO RET

 +52       XECUTE ^%ZOSF("UCI")

           SET X="UCI: "_$PIECE(Y,",")

           DO CTR^AG

           SET AGUCI=X

           SET X=$PIECE(^DIC(4,AGGDUZ2,0),U)

           DO CTR^AG

           SET AG("LOC")=X

           SET AG("USR")=$PIECE(^VA(200,DUZ,0),U)

           SET AGBM=IOSL-10

           IF $DATA(AGIO)

               IF AGIO=IO

                   SET AGBM=IOSL-4

 +53       SET AGBDTS=AGBDT

 +54       DO SCAN^AGGRPRT1

 +55       IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)

               GOTO DONE

 +56       DO PRINT^AGGRPRT1

 +57      ;D OPEN^%ZISH("AGGFILE",HDIR,HFN,"A")

RET       ;

 +1        USE IO

           WRITE $CHAR(9)

 +2       ;

 +3       ;

 +4        IF $$TMPFL^AGGUL1("C")

               GOTO DONE

 +5        IF $$TMPFL^AGGUL1("R",UID,"AGG"_$JOB)

               GOTO DONE

 +6       ;

 +7       ;:$ZEOF=-1

FOR

               USE IO

               READ HSTEXT:.1

               IF HSTEXT[$CHAR(9)

                   QUIT

               Begin DoDot:1

 +8                SET HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")

 +9                IF HSTEXT=""

                       SET HSTEXT=" "

 +10               SET AGGI=AGGI+1

                   SET @DATA@(AGGI)=HSTEXT_$CHAR(13)_$CHAR(10)_$CHAR(30)

               End DoDot:1

 +11       SET AGGI=AGGI+1

           SET @DATA@(AGGI)=$CHAR(30)

 +12      ;

 +13       IF $$TMPFL^AGGUL1("C")

               GOTO DONE

 +14       IF $$TMPFL^AGGUL1("D",UID,"AGG"_$JOB)

               GOTO DONE

 +15      ;

DONE      ;

 +1       ;

 +2        SET AGGI=AGGI+1

           SET @DATA@(AGGI)=$CHAR(31)

 +3        KILL ROUTINE

 +4        QUIT

 +5       ;

HDR       ;

 +1        SET @DATA@(AGGI)="T01024REPORT_TEXT"_$CHAR(30)

 +2        QUIT

 +3       ;

ERR       ;

 +1        DO ^%ZTER

 +2        NEW Y,ERRDTM

 +3        SET Y=$$NOW^XLFDT()

           XECUTE ^DD("DD")

           SET ERRDTM=Y

 +4        SET BMXSEC="Recording that an error occurred at "_ERRDTM

 +5        IF $DATA(AGGI)

               IF $DATA(DATA)

                   SET AGGI=AGGI+1

                   SET @DATA@(AGGI)=$CHAR(31)

 +6        IF $$TMPFL^AGGUL1("C")

 +7        QUIT

AGGRPRT.m