AGTXERP ; IHS/ASDS/EFG - OCT 27,1992 ;
;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007
I '(^AGTXER(0)) W !!,"No errors were found during the export procedure.",!!! H 4 Q
W !!,"There were ",^AGTXER(0)," patients with errors found during this process.",!!,"Stand-by for the error report.",!! S AGIO=IO,AG("HAT")=""
DEV I '$G(IO) S IOP="HOME" D ^%ZIS
S %ZIS="OPQ" D ^%ZIS I POP S IOP=ION D ^%ZIS Q
G:'$D(IO("Q")) START K IO("Q") I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
S:'$G(AGTXSITE) AGTXSITE=$P($G(^AUTTSITE(1,0)),U) ;AG*7.1*2 IM22637
X ^%ZOSF("UCI") S ZTRTN="START^AGTXERP",ZTUCI=Y,ZTDESC="Error Report For Data Exported for "_$P($G(^AUTTLOC(AGTXSITE,0)),U,2)_".",ZTSAVE=""
D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,AGIO,ZTDESC,ZTRTN,ZTSK,ZTUCI D ^%ZISC
Q
START ;EP - From Taskman.
S AGTXSITE=$P(^AUTTSITE(1,0),U)
U IO X ^%ZOSF("UCI") S X="UCI: "_$P(Y,",") D CTR^AG S AGUCI=X,(AGPGPG,AG("SITE"),AGTOTAL)=0,X=$P(^DIC(4,AGTXSITE,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
D ^AGVAR:'$D(AGOPT),VAR^AGBADATA,LINES^AG,NOW^AG S X="as of "_AGTIME D CTR^AG S AGTIME=X D HDR
B S AG("SITE")=$O(^AGTXER(AG("SITE"))) G END:+AG("SITE")=0
C F DFN=0:0 S DFN=$O(^AGTXER(AG("SITE"),DFN)) G B:DFN="" S AGSITE=DUZ(2),DUZ(2)=AG("SITE") D ^AGDATCK S DUZ(2)=AGSITE I AG("DTOT")>0 D PRINT G:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) END1 I $Y>AGBM D RTRN^AG G:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) END1 D HDR
END W !!,"TOTAL PATIENTS WITH INVALID DATA: ",AGTOTAL K AG("HAT") D RTRN^AG W $$S^AGVDF("IOF")
END1 D ^%ZISC K AG,AGIO,AGSITE,AGTIME,AGBM,DUOUT,DTOUT,DFOUT,I,IOP,J,AG("LOC"),AGPGPG,AG("SITE"),AGTOTAL,AGUCI,AG("USR"),X,XY,XYER,Y D:$D(ZTQUEUED) KILL^%ZTLOAD
Q
PRINT ;Print invalid patient data.
W:$D(^DPT(DFN,0)) $P(^DPT(DFN,0),U) W:$D(^AUPNPAT(DFN,41,AG("SITE"),0)) ?35,$P(^AUPNPAT(DFN,41,AG("SITE"),0),U,2),?45,$P(^DIC(4,AG("SITE"),0),U)
;S Y=$P(^AUPNPAT(DFN,0),U,3) I Y D DD^%DT W !,"Last Registration Update : ",Y
S Y=$P($G(^AUPNPAT(DFN,0)),U,3) I Y D DD^%DT W !,"Last Registration Update : ",Y ;AG*7.1*2 REPORTED DURING ALPHA
I '$D(^AUPNPAT(DFN,41,AG("SITE"),0))&'$D(AG("ER",2)) S A=0,A=$O(^AUPNPAT(DFN,41,A)) W:A'=0 ?35,$P(^AUPNPAT(DFN,41,A,0),U,2),?45,$P(^DIC(4,A,0),U) K A
F I=1:1:14 I $D(AG("ER",I)) W !?5,AG(I) I $Y>AGBM F J=I+1:1:13 I $D(AG("ER",J)) D RTRN^AG Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT) D HDR W "(Cont.)" Q
Q:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
S AGTOTAL=AGTOTAL+1 W !,AG("-"),!
Q
HDR S AGPGPG=AGPGPG+1 W $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?22,"INVALID DATA ENTRIES - PATIENT FILES",!,AGUCI,!,AGTIME,!!,"PATIENT'S NAME",?35,"CHART # FACILITY",!?5,"ERRORS FOUND",!,AG("="),!
Q
AGTXCK ;EP - (from option) Error check before creating transactions.
S DIC=9009063.01,DA=DUZ(2),DR=9,AG("DRENT")=0 D ^AGDICLK I $D(AG("LKDATA")),AG("LKDATA")="N" D RESET^AGTX
D VIDEO^AG,SETCHDFN^AGTX0
G AGTXERP
AGTXERP ; IHS/ASDS/EFG - OCT 27,1992 ;
+1 ;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007
+2 IF '(^AGTXER(0))
WRITE !!,"No errors were found during the export procedure.",!!!
HANG 4
QUIT
+3 WRITE !!,"There were ",^AGTXER(0)," patients with errors found during this process.",!!,"Stand-by for the error report.",!!
SET AGIO=IO
SET AG("HAT")=""
DEV IF '$GET(IO)
SET IOP="HOME"
DO ^%ZIS
+1 SET %ZIS="OPQ"
DO ^%ZIS
IF POP
SET IOP=ION
DO ^%ZIS
QUIT
+2 IF '$DATA(IO("Q"))
GOTO START
KILL IO("Q")
IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+3 ;AG*7.1*2 IM22637
IF '$GET(AGTXSITE)
SET AGTXSITE=$PIECE($GET(^AUTTSITE(1,0)),U)
+4 XECUTE ^%ZOSF("UCI")
SET ZTRTN="START^AGTXERP"
SET ZTUCI=Y
SET ZTDESC="Error Report For Data Exported for "_$PIECE($GET(^AUTTLOC(AGTXSITE,0)),U,2)_"."
SET ZTSAVE=""
+5 DO ^%ZTLOAD
IF '$DATA(ZTSK)
GOTO DEV
KILL AG,AGIO,ZTDESC,ZTRTN,ZTSK,ZTUCI
DO ^%ZISC
+6 QUIT
START ;EP - From Taskman.
+1 SET AGTXSITE=$PIECE(^AUTTSITE(1,0),U)
+2 USE IO
XECUTE ^%ZOSF("UCI")
SET X="UCI: "_$PIECE(Y,",")
DO CTR^AG
SET AGUCI=X
SET (AGPGPG,AG("SITE"),AGTOTAL)=0
SET X=$PIECE(^DIC(4,AGTXSITE,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
+3 IF '$DATA(AGOPT)
DO ^AGVAR
DO VAR^AGBADATA
DO LINES^AG
DO NOW^AG
SET X="as of "_AGTIME
DO CTR^AG
SET AGTIME=X
DO HDR
B SET AG("SITE")=$ORDER(^AGTXER(AG("SITE")))
IF +AG("SITE")=0
GOTO END
C FOR DFN=0:0
SET DFN=$ORDER(^AGTXER(AG("SITE"),DFN))
IF DFN=""
GOTO B
SET AGSITE=DUZ(2)
SET DUZ(2)=AG("SITE")
DO ^AGDATCK
SET DUZ(2)=AGSITE
IF AG("DTOT")>0
DO PRINT
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
GOTO END1
IF $Y>AGBM
DO RTRN^AG
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
GOTO END1
DO HDR
END WRITE !!,"TOTAL PATIENTS WITH INVALID DATA: ",AGTOTAL
KILL AG("HAT")
DO RTRN^AG
WRITE $$S^AGVDF("IOF")
END1 DO ^%ZISC
KILL AG,AGIO,AGSITE,AGTIME,AGBM,DUOUT,DTOUT,DFOUT,I,IOP,J,AG("LOC"),AGPGPG,AG("SITE"),AGTOTAL,AGUCI,AG("USR"),X,XY,XYER,Y
IF $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+1 QUIT
PRINT ;Print invalid patient data.
+1 IF $DATA(^DPT(DFN,0))
WRITE $PIECE(^DPT(DFN,0),U)
IF $DATA(^AUPNPAT(DFN,41,AG("SITE"),0))
WRITE ?35,$PIECE(^AUPNPAT(DFN,41,AG("SITE"),0),U,2),?45,$PIECE(^DIC(4,AG("SITE"),0),U)
+2 ;S Y=$P(^AUPNPAT(DFN,0),U,3) I Y D DD^%DT W !,"Last Registration Update : ",Y
+3 ;AG*7.1*2 REPORTED DURING ALPHA
SET Y=$PIECE($GET(^AUPNPAT(DFN,0)),U,3)
IF Y
DO DD^%DT
WRITE !,"Last Registration Update : ",Y
+4 IF '$DATA(^AUPNPAT(DFN,41,AG("SITE"),0))&'$DATA(AG("ER",2))
SET A=0
SET A=$ORDER(^AUPNPAT(DFN,41,A))
IF A'=0
WRITE ?35,$PIECE(^AUPNPAT(DFN,41,A,0),U,2),?45,$PIECE(^DIC(4,A,0),U)
KILL A
+5 FOR I=1:1:14
IF $DATA(AG("ER",I))
WRITE !?5,AG(I)
IF $Y>AGBM
FOR J=I+1:1:13
IF $DATA(AG("ER",J))
DO RTRN^AG
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
DO HDR
WRITE "(Cont.)"
QUIT
+6 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
QUIT
+7 SET AGTOTAL=AGTOTAL+1
WRITE !,AG("-"),!
+8 QUIT
HDR SET AGPGPG=AGPGPG+1
WRITE $$S^AGVDF("IOF"),!!,AG("USR"),?72,"page ",AGPGPG,!,AG("LOC"),!?22,"INVALID DATA ENTRIES - PATIENT FILES",!,AGUCI,!,AGTIME,!!,"PATIENT'S NAME",?35,"CHART # FACILITY",!?5,"ERRORS FOUND",!,AG("="),!
+1 QUIT
AGTXCK ;EP - (from option) Error check before creating transactions.
+1 SET DIC=9009063.01
SET DA=DUZ(2)
SET DR=9
SET AG("DRENT")=0
DO ^AGDICLK
IF $DATA(AG("LKDATA"))
IF AG("LKDATA")="N"
DO RESET^AGTX
+2 DO VIDEO^AG
DO SETCHDFN^AGTX0
+3 GOTO AGTXERP
