AGGRPRT ; VNGT/HS/KDC - DAILY REGISTRATION ACTIVITY REPORT
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
; Copied from AGREPRT
;
Q
;
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
Q
;
HDR ;
S @DATA@(AGGI)="T01024REPORT_TEXT"_$C(30)
Q
;
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")
Q
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
