SD53P227 ;ALB/RBS - Cleanup Encounter/Visit Date/Time 421 error ; 10/11/00 5:24pm
;;5.3;Scheduling;**227,1015**;AUG 13, 1993;Build 21
;
;DBIA Integration Reference # 3211.
;
;This routine will search for Encounters that have an invalid date
;and time setup causing a 421 error code to be setup.
;An attempt will be made to cleanup the date/time.
;Two options are provided for finding or fixing the 421 errors.
;The report will detail all 421 Encounters that can-not or can be
;fixed and flagged for retransmittion to the NCPD.
;An e-mail summary will be sent to the user running this utility.
;
;The ^XTMP global will be used as an audit file of all encounters
;that have been fixed and retransmitted to the NPCD.
;The purge date will be 30 days from last Cleanup option run.
; ^XTMP("SD53P227",0)=STRING of 10 fields
; STRING = purge date^run date^start dt/time^stop dt/time...
; ^option run^last cleanup d/t run^DUZ of user...
; ^tot errors^tot fixed^tot searched
; ^XTMP("SD53P227",1)=error node of encounters that can't be fixed
; ^XTMP("SD53P227",2)=encounters that can be fixed and re-sent
; ^XTMP("SD53P227",3)=e-mail report sent to user
; ^XTMP("SD53P227,"SENT")=audit trial of all encounters fixed
Q
;*;
START ;Check for Programmer DUZ(0)="@", then Prompt for Device.
N EXIT,SDRTYP,TITLE,TXT,X,Y
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE,ZTQUEUED,ZTREQ,%ZIS
D TITLE
I $G(DUZ)<1 W !!,$C(7),"DUZ must be defined to run this utility!" Q
I DUZ(0)'="@" D Q
.W !!,$C(7)," Sorry, you may not access this utility program!"
.W !," To insure that data updates contained in this patch are"
.W !," installed correctly, DUZ(0) must be equal the ""@"" symbol!",!! H 3
;
L +^XTMP("SD53P227"):2
I '$T D Q
.W !!,$C(7),"* This utility is already running. Please try later. *",! H 3
;
S EXIT=0
I $D(^XTMP("SD53P227")) D
.S X=$G(^XTMP("SD53P227",0))
.Q:X=""
.I $P(X,U,4)="" D Q
..S EXIT=1
..W !!!,$C(7),"* This utility is currently running. Start D/T: ",$$FMTE^XLFDT($P(X,U,3)),! H 3
.; if cleanup already run, ask user if they want to run again...
.I $D(^XTMP("SD53P227","SENT")) D
..W !!,$C(7),"* WARNING * The 'C' (Clean Up & Report) option has already been run"
..W !?12,"on: ",$$FMTE^XLFDT($P(X,U,6)),!
..S EXIT=$$ASK()
..I EXIT'=1 S EXIT=1 Q ;user didn't answer 'Y'es.
..S EXIT=0
I EXIT D EXIT Q
;
; Prompt user for option to run...
D TITLE,MSG
I $$REPORT(.SDRTYP)'>-1 D EXIT Q
;
W !!
L -^XTMP("SD53P227")
;
S %ZIS="Q" S:SDRTYP="C" %ZIS="Q0" ;0=can't use own $IO
D ^%ZIS
Q:POP
I $D(IO("Q")) D QUEUE Q
D RUN,^%ZISC
Q
;
QUEUE ; queue the report
S ZTSAVE("SDRTYP")="",ZTSAVE("TITLE")=""
S ZTRTN="RUN^SD53P227",ZTDESC="Cleanup Encounters w/421 error code"
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Unable to schedule Task.",!
E W !!?5,"Scheduled as Task #: ",ZTSK
D HOME^%ZIS
Q
;
;
RUN ;Loop the 409.75 Transmitted Outpatient Encounter Error file
L +^XTMP("SD53P227"):2
I '$T D Q
.N SDMSG,XMSUB,XMDUZ,XMDUN,XMTEXT,XMY
.S XMSUB=TITLE,(XMDUZ,XMDUN)="Patch SD*5.3*227",XMY(DUZ)=""
.S SDMSG(1)="*WARNING* Processing not started."
.S SDMSG(2)=" Unable to LOCK error."
.S SDMSG(3)=" Please check system."
.S XMTEXT="SDMSG("
.D ^XMD
I '$D(ZTQUEUED),IOST?1"C-".E D WAIT^DICD
N CRT,EXIT,FIX,RUNDT,SDI,SDL,SDTEMP,TIMESTRT,X,Y
S TIMESTRT=$$NOW^XLFDT() ;starting time
S (CRT,EXIT,FIX,SDL)=0,(SDI,X)=""
I '$D(ZTQUEUED),IOST?1"C-".E S CRT=1 ;print to screen
S:SDRTYP="C" FIX=1 ;re-set date/time
;
; create ^XTMP() file to save fixed records
I '$D(^XTMP("SD53P227","SENT")) K ^XTMP("SD53P227")
; If already run, don't kill node of encounters already fixed...
I $D(^XTMP("SD53P227","SENT")) D
.S X=^XTMP("SD53P227",0)
.F SDI=1,2,3 K ^XTMP("SD53P227",SDI)
; setup 0 node info
S $P(X,U)=$$HTFM^XLFDT(+$H+30),$P(X,U,2)=$$DT^XLFDT()
S $P(X,U,3)=TIMESTRT,$P(X,U,4)="",$P(X,U,5)=SDRTYP,$P(X,U,7)=DUZ
S:FIX $P(X,U,6)=TIMESTRT
S ^XTMP("SD53P227",0)=X,SDTEMP="^XTMP(""SD53P227"")"
;
D FIND^SD53227P ;search for encounters
;
I EXIT D MAIL,EXIT Q ;early exit
D PRINT^SD53227,MAIL,EXIT ;do printing & e-mail
S ZTREQ="@"
Q
;
;
MAIL ;Send mail message
N XMSUB,XMDUZ,XMDUN,XMTEXT,XMY,XMZ
S XMSUB="SD53P227 Encounter Report"_$S(SDRTYP="R":"",1:" & Cleanup")
S (XMDUZ,XMDUN)="SD*5.3*227",XMY(DUZ)=""
S XMTEXT="^XTMP(""SD53P227"",3,"
D ^XMD
Q
;
EXIT ;Clean up and quit
;check to see if process ran
N X
I $D(TIMESTRT) D
.S X=@SDTEMP@(0),$P(X,U,4)=$$NOW^XLFDT(),@SDTEMP@(0)=X ;stop d/t
;
L -^XTMP("SD53P227")
Q
;
REPORT(SDR) ;Select Utility action type
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="S^R:REPORT ONLY;C:CLEAN UP & REPORT",DIR("A")="Select utility format"
S DIR("?",1)=" R - (REPORT ONLY) - will produce a mail message report of Encounter"
S DIR("?",2)=" records (#409.75 file) with a 421 error code."
S DIR("?",3)=" C - (CLEAN UP & REPORT) - will fix both the Encounter (409.68 file)"
S DIR("?",4)=" and Visit (#9000010 file) records that are found and produce"
S DIR("?")=" a mail message report of those records."
W !!,$C(7) D ^DIR K DIR
I $D(DIRUT)!$D(DTOUT)!$D(DUOUT) S Y=-1 Q Y
S SDR=Y
Q Y
;
ASK() ; Ask user to contuine or not
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="Y"
S DIR("A")="Do you want to continue",DIR("B")="NO"
D ^DIR K DIR
I $D(DIRUT)!$D(DTOUT)!$D(DUOUT) Q 0
Q Y
;
MSG ; List information message
W !!,"This utility will Report on and Clean Up Encounter Date/Time"
W !,"error code 421 entries in the #409.75 and #9000010 files."
W !,"Both options will E-mail a summary report to the user."
W !,"Updated entries will be flagged for Retransmission to the NPCD."
W !!,"The REPORT ONLY option does NOT update any file information."
W !,"You may run the REPORT ONLY option to your CRT or to a device."
W !,"The CLEAN UP & REPORT option MUST be queued to a device."
Q
;
TITLE ; Screen title
W @IOF
S TITLE="SD*5.3*227 Encounter 421 Error Report & Cleanup"
W !!,?(80-$L(TITLE)\2),TITLE
S X=$$HTE^XLFDT($H)
W !,?(80-$L(X)\2),X
Q
SD53P227 ;ALB/RBS - Cleanup Encounter/Visit Date/Time 421 error ; 10/11/00 5:24pm
+1 ;;5.3;Scheduling;**227,1015**;AUG 13, 1993;Build 21
+2 ;
+3 ;DBIA Integration Reference # 3211.
+4 ;
+5 ;This routine will search for Encounters that have an invalid date
+6 ;and time setup causing a 421 error code to be setup.
+7 ;An attempt will be made to cleanup the date/time.
+8 ;Two options are provided for finding or fixing the 421 errors.
+9 ;The report will detail all 421 Encounters that can-not or can be
+10 ;fixed and flagged for retransmittion to the NCPD.
+11 ;An e-mail summary will be sent to the user running this utility.
+12 ;
+13 ;The ^XTMP global will be used as an audit file of all encounters
+14 ;that have been fixed and retransmitted to the NPCD.
+15 ;The purge date will be 30 days from last Cleanup option run.
+16 ; ^XTMP("SD53P227",0)=STRING of 10 fields
+17 ; STRING = purge date^run date^start dt/time^stop dt/time...
+18 ; ^option run^last cleanup d/t run^DUZ of user...
+19 ; ^tot errors^tot fixed^tot searched
+20 ; ^XTMP("SD53P227",1)=error node of encounters that can't be fixed
+21 ; ^XTMP("SD53P227",2)=encounters that can be fixed and re-sent
+22 ; ^XTMP("SD53P227",3)=e-mail report sent to user
+23 ; ^XTMP("SD53P227,"SENT")=audit trial of all encounters fixed
+24 QUIT
+25 ;*;
START ;Check for Programmer DUZ(0)="@", then Prompt for Device.
+1 NEW EXIT,SDRTYP,TITLE,TXT,X,Y
+2 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE,ZTQUEUED,ZTREQ,%ZIS
+3 DO TITLE
+4 IF $GET(DUZ)<1
WRITE !!,$CHAR(7),"DUZ must be defined to run this utility!"
QUIT
+5 IF DUZ(0)'="@"
Begin DoDot:1
+6 WRITE !!,$CHAR(7)," Sorry, you may not access this utility program!"
+7 WRITE !," To insure that data updates contained in this patch are"
+8 WRITE !," installed correctly, DUZ(0) must be equal the ""@"" symbol!",!!
HANG 3
End DoDot:1
QUIT
+9 ;
+10 LOCK +^XTMP("SD53P227"):2
+11 IF '$TEST
Begin DoDot:1
+12 WRITE !!,$CHAR(7),"* This utility is already running. Please try later. *",!
HANG 3
End DoDot:1
QUIT
+13 ;
+14 SET EXIT=0
+15 IF $DATA(^XTMP("SD53P227"))
Begin DoDot:1
+16 SET X=$GET(^XTMP("SD53P227",0))
+17 IF X=""
QUIT
+18 IF $PIECE(X,U,4)=""
Begin DoDot:2
+19 SET EXIT=1
+20 WRITE !!!,$CHAR(7),"* This utility is currently running. Start D/T: ",$$FMTE^XLFDT($PIECE(X,U,3)),!
HANG 3
End DoDot:2
QUIT
+21 ; if cleanup already run, ask user if they want to run again...
+22 IF $DATA(^XTMP("SD53P227","SENT"))
Begin DoDot:2
+23 WRITE !!,$CHAR(7),"* WARNING * The 'C' (Clean Up & Report) option has already been run"
+24 WRITE !?12,"on: ",$$FMTE^XLFDT($PIECE(X,U,6)),!
+25 SET EXIT=$$ASK()
+26 ;user didn't answer 'Y'es.
IF EXIT'=1
SET EXIT=1
QUIT
+27 SET EXIT=0
End DoDot:2
End DoDot:1
+28 IF EXIT
DO EXIT
QUIT
+29 ;
+30 ; Prompt user for option to run...
+31 DO TITLE
DO MSG
+32 IF $$REPORT(.SDRTYP)'>-1
DO EXIT
QUIT
+33 ;
+34 WRITE !!
+35 LOCK -^XTMP("SD53P227")
+36 ;
+37 ;0=can't use own $IO
SET %ZIS="Q"
IF SDRTYP="C"
SET %ZIS="Q0"
+38 DO ^%ZIS
+39 IF POP
QUIT
+40 IF $DATA(IO("Q"))
DO QUEUE
QUIT
+41 DO RUN
DO ^%ZISC
+42 QUIT
+43 ;
QUEUE ; queue the report
+1 SET ZTSAVE("SDRTYP")=""
SET ZTSAVE("TITLE")=""
+2 SET ZTRTN="RUN^SD53P227"
SET ZTDESC="Cleanup Encounters w/421 error code"
+3 DO ^%ZTLOAD
+4 IF $DATA(ZTSK)[0
WRITE !!?5,"Unable to schedule Task.",!
+5 IF '$TEST
WRITE !!?5,"Scheduled as Task #: ",ZTSK
+6 DO HOME^%ZIS
+7 QUIT
+8 ;
+9 ;
RUN ;Loop the 409.75 Transmitted Outpatient Encounter Error file
+1 LOCK +^XTMP("SD53P227"):2
+2 IF '$TEST
Begin DoDot:1
+3 NEW SDMSG,XMSUB,XMDUZ,XMDUN,XMTEXT,XMY
+4 SET XMSUB=TITLE
SET (XMDUZ,XMDUN)="Patch SD*5.3*227"
SET XMY(DUZ)=""
+5 SET SDMSG(1)="*WARNING* Processing not started."
+6 SET SDMSG(2)=" Unable to LOCK error."
+7 SET SDMSG(3)=" Please check system."
+8 SET XMTEXT="SDMSG("
+9 DO ^XMD
End DoDot:1
QUIT
+10 IF '$DATA(ZTQUEUED)
IF IOST?1"C-".E
DO WAIT^DICD
+11 NEW CRT,EXIT,FIX,RUNDT,SDI,SDL,SDTEMP,TIMESTRT,X,Y
+12 ;starting time
SET TIMESTRT=$$NOW^XLFDT()
+13 SET (CRT,EXIT,FIX,SDL)=0
SET (SDI,X)=""
+14 ;print to screen
IF '$DATA(ZTQUEUED)
IF IOST?1"C-".E
SET CRT=1
+15 ;re-set date/time
IF SDRTYP="C"
SET FIX=1
+16 ;
+17 ; create ^XTMP() file to save fixed records
+18 IF '$DATA(^XTMP("SD53P227","SENT"))
KILL ^XTMP("SD53P227")
+19 ; If already run, don't kill node of encounters already fixed...
+20 IF $DATA(^XTMP("SD53P227","SENT"))
Begin DoDot:1
+21 SET X=^XTMP("SD53P227",0)
+22 FOR SDI=1,2,3
KILL ^XTMP("SD53P227",SDI)
End DoDot:1
+23 ; setup 0 node info
+24 SET $PIECE(X,U)=$$HTFM^XLFDT(+$HOROLOG+30)
SET $PIECE(X,U,2)=$$DT^XLFDT()
+25 SET $PIECE(X,U,3)=TIMESTRT
SET $PIECE(X,U,4)=""
SET $PIECE(X,U,5)=SDRTYP
SET $PIECE(X,U,7)=DUZ
+26 IF FIX
SET $PIECE(X,U,6)=TIMESTRT
+27 SET ^XTMP("SD53P227",0)=X
SET SDTEMP="^XTMP(""SD53P227"")"
+28 ;
+29 ;search for encounters
DO FIND^SD53227P
+30 ;
+31 ;early exit
IF EXIT
DO MAIL
DO EXIT
QUIT
+32 ;do printing & e-mail
DO PRINT^SD53227
DO MAIL
DO EXIT
+33 SET ZTREQ="@"
+34 QUIT
+35 ;
+36 ;
MAIL ;Send mail message
+1 NEW XMSUB,XMDUZ,XMDUN,XMTEXT,XMY,XMZ
+2 SET XMSUB="SD53P227 Encounter Report"_$SELECT(SDRTYP="R":"",1:" & Cleanup")
+3 SET (XMDUZ,XMDUN)="SD*5.3*227"
SET XMY(DUZ)=""
+4 SET XMTEXT="^XTMP(""SD53P227"",3,"
+5 DO ^XMD
+6 QUIT
+7 ;
EXIT ;Clean up and quit
+1 ;check to see if process ran
+2 NEW X
+3 IF $DATA(TIMESTRT)
Begin DoDot:1
+4 ;stop d/t
SET X=@SDTEMP@(0)
SET $PIECE(X,U,4)=$$NOW^XLFDT()
SET @SDTEMP@(0)=X
End DoDot:1
+5 ;
+6 LOCK -^XTMP("SD53P227")
+7 QUIT
+8 ;
REPORT(SDR) ;Select Utility action type
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="S^R:REPORT ONLY;C:CLEAN UP & REPORT"
SET DIR("A")="Select utility format"
+3 SET DIR("?",1)=" R - (REPORT ONLY) - will produce a mail message report of Encounter"
+4 SET DIR("?",2)=" records (#409.75 file) with a 421 error code."
+5 SET DIR("?",3)=" C - (CLEAN UP & REPORT) - will fix both the Encounter (409.68 file)"
+6 SET DIR("?",4)=" and Visit (#9000010 file) records that are found and produce"
+7 SET DIR("?")=" a mail message report of those records."
+8 WRITE !!,$CHAR(7)
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
SET Y=-1
QUIT Y
+10 SET SDR=Y
+11 QUIT Y
+12 ;
ASK() ; Ask user to contuine or not
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Do you want to continue"
SET DIR("B")="NO"
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+6 QUIT Y
+7 ;
MSG ; List information message
+1 WRITE !!,"This utility will Report on and Clean Up Encounter Date/Time"
+2 WRITE !,"error code 421 entries in the #409.75 and #9000010 files."
+3 WRITE !,"Both options will E-mail a summary report to the user."
+4 WRITE !,"Updated entries will be flagged for Retransmission to the NPCD."
+5 WRITE !!,"The REPORT ONLY option does NOT update any file information."
+6 WRITE !,"You may run the REPORT ONLY option to your CRT or to a device."
+7 WRITE !,"The CLEAN UP & REPORT option MUST be queued to a device."
+8 QUIT
+9 ;
TITLE ; Screen title
+1 WRITE @IOF
+2 SET TITLE="SD*5.3*227 Encounter 421 Error Report & Cleanup"
+3 WRITE !!,?(80-$LENGTH(TITLE)\2),TITLE
+4 SET X=$$HTE^XLFDT($HOROLOG)
+5 WRITE !,?(80-$LENGTH(X)\2),X
+6 QUIT
