SD53103B ;ALB/MJK - Unique Visit ID Clean Up ; March 10,1997
;;5.3;Scheduling;**103,1015**;AUG 13, 1993;Build 21
;
Q
;
OE(SDOE) ; -- display oe data
N DIQ,DIC,DR,DA,SDLINE
S $P(SDLINE,"=",80)=""
W !,SDLINE,!
S DIC="^SCE(",DA=SDOE,DIQ(0)="CAR" D EN^DIQ
W !,SDLINE,!
Q
;
HDR(TEXT) ; -- intro header
N X
S X=">>>> Encounter Clean Up Tool for -1 Visit ID's ["_TEXT_"] <<<<"
S T=(80-$L(X))/2
W @IOF,!?T,X
Q
;
INIT() ; -- init global locals
N SDOK
D HOME^%ZIS
S SDOK=1,U="^",SDTALK=0
IF '$G(DT) S DT=$$DT^XLFDT()
;
IF '$G(DUZ) D G INITQ
. W !,"DUZ is not defined."
. S SDOK=0
;
IF '$O(^DIC(9.4,"C","SD",0)) D G INITQ
. W !,"No package with 'SD' namespace exists on the system."
. S SDOK=0
ELSE D
. S SDPKG=$O(^DIC(9.4,"C","SD",0))
;
INITQ Q SDOK
;
RESULTS(SDMODE,SDBEG,SDEND,SDRT,SDCNT) ; generate an e-mail bulletin when done
N DIFROM,I,LINE,X
S SDCOUNT=0
D LINE("The Unique Visit ID cleanup has run to completion."),LINE("")
D LINE(" Start Time: "_$$FMTE^XLFDT(SDBEG))
D LINE(" End Time: "_$$FMTE^XLFDT(SDEND))
D LINE(" Run Mode: "_$S(SDMODE=1:"Count Only",1:"Fix Entries")),LINE("")
IF $$S^%ZTLOAD D
. D LINE(" >>> Task Stopped by user. <<<")
. D LINE("")
. S ZTSTOP=1
;
D LINE("Total number of Outpatient Encounter entries "_$S(SDMODE=1:"that will be ",1:"")_"processed: "_SDCNT),LINE(""),LINE("")
;
IF SDMODE=2 D
. D LINE("Note: Child encounters re-linked as part of parent")
. D LINE(" re-linking process are not listed below nor")
. D LINE(" counted in the total above.")
. D LINE("")
;
; -- layout of line
D LINE("Message Format:")
D LINE(" Piece Description")
D LINE(" ----- -----------")
D LINE(" 1 Status of update")
D LINE(" 2 Internal Entry Number of Outpatient Encounter file")
D LINE(" 3 Internal Entry Number of Parent Outpatient Encounter file")
D LINE(" 4 Internal Entry Number of Visit file")
D LINE(" 5 Patient Name")
D LINE(" 6 Encounter Date/Time")
D LINE(" 7 Hospital Location")
D LINE("")
;
; --scan tmp records
F I=0:0 S I=$O(@SDRT@(I)) Q:'I D
. D LINE(@SDRT@(I))
;
; -- set up and fire bulletin
S XMSUB="Unique Visit ID Cleanup is Complete",XMN=0
S XMTEXT="^TMP(""SDVISIT MSG"",$J,"
S XMDUZ=.5,XMY(DUZ)=""
D ^XMD
K ^TMP("SDVISIT MSG",$J)
K SDCOUNT,SDTEXT,XMDUZ,XMN,XMSUB,XMTEXT,XMY,XMZ
Q
;
;
LINE(TEXT) ; add text to mail message
S SDCOUNT=SDCOUNT+1,^TMP("SDVISIT MSG",$J,SDCOUNT)=TEXT
Q
;
RANGE(SDBEG,SDEND) ; -- select range
N SDWITCH,SDT,X1,X2,X,DIR
S (SDBEG,SDEND)=0,SDT=2961001
S DIR("B")=$$FDATE^VALM1(SDT)
S DIR(0)="DA"_U_SDT_":"_DT_":EXP",DIR("A")="Select Beginning Date: "
S DIR("?",1)="Enter a date between "_$$FMTE^XLFDT(SDT)_" to "_$$FMTE^XLFDT(DT)_".",DIR("?")=" "
W ! D ^DIR K DIR G RANGEQ:Y'>0 S SDBEG=Y
S DIR("B")=$$FDATE^VALM1(DT)
S DIR(0)="DA"_U_SDBEG_":"_DT_":EXP",DIR("A")="Select Ending Date: "
S DIR("?",1)="Enter a date between "_$$FMTE^XLFDT(SDBEG)_" to "_$$FMTE^XLFDT(DT)_".",DIR("?")=" "
D ^DIR K DIR G RANGEQ:Y'>0 S SDEND=Y_".235959"
RANGEQ Q SDEND
;
OK() ; -- ok to continue
N DIR,Y
S DIR("A")="Ok to continue"
S DIR("B")="NO"
S DIR(0)="Y"
D ^DIR
IF Y'=1 S Y=0
Q Y
;
MODE() ; -- select update mode
N DIR,Y
S DIR(0)="S"_U_"1:Count Only;2:Fix Entries"
S DIR("A")="Select update mode"
S DIR("B")="Count Only"
D ^DIR
IF Y'=1,Y'=2 S Y=0
Q Y
;
SD53103B ;ALB/MJK - Unique Visit ID Clean Up ; March 10,1997
+1 ;;5.3;Scheduling;**103,1015**;AUG 13, 1993;Build 21
+2 ;
+3 QUIT
+4 ;
OE(SDOE) ; -- display oe data
+1 NEW DIQ,DIC,DR,DA,SDLINE
+2 SET $PIECE(SDLINE,"=",80)=""
+3 WRITE !,SDLINE,!
+4 SET DIC="^SCE("
SET DA=SDOE
SET DIQ(0)="CAR"
DO EN^DIQ
+5 WRITE !,SDLINE,!
+6 QUIT
+7 ;
HDR(TEXT) ; -- intro header
+1 NEW X
+2 SET X=">>>> Encounter Clean Up Tool for -1 Visit ID's ["_TEXT_"] <<<<"
+3 SET T=(80-$LENGTH(X))/2
+4 WRITE @IOF,!?T,X
+5 QUIT
+6 ;
INIT() ; -- init global locals
+1 NEW SDOK
+2 DO HOME^%ZIS
+3 SET SDOK=1
SET U="^"
SET SDTALK=0
+4 IF '$GET(DT)
SET DT=$$DT^XLFDT()
+5 ;
+6 IF '$GET(DUZ)
Begin DoDot:1
+7 WRITE !,"DUZ is not defined."
+8 SET SDOK=0
End DoDot:1
GOTO INITQ
+9 ;
+10 IF '$ORDER(^DIC(9.4,"C","SD",0))
Begin DoDot:1
+11 WRITE !,"No package with 'SD' namespace exists on the system."
+12 SET SDOK=0
End DoDot:1
GOTO INITQ
+13 IF '$TEST
Begin DoDot:1
+14 SET SDPKG=$ORDER(^DIC(9.4,"C","SD",0))
End DoDot:1
+15 ;
INITQ QUIT SDOK
+1 ;
RESULTS(SDMODE,SDBEG,SDEND,SDRT,SDCNT) ; generate an e-mail bulletin when done
+1 NEW DIFROM,I,LINE,X
+2 SET SDCOUNT=0
+3 DO LINE("The Unique Visit ID cleanup has run to completion.")
DO LINE("")
+4 DO LINE(" Start Time: "_$$FMTE^XLFDT(SDBEG))
+5 DO LINE(" End Time: "_$$FMTE^XLFDT(SDEND))
+6 DO LINE(" Run Mode: "_$SELECT(SDMODE=1:"Count Only",1:"Fix Entries"))
DO LINE("")
+7 IF $$S^%ZTLOAD
Begin DoDot:1
+8 DO LINE(" >>> Task Stopped by user. <<<")
+9 DO LINE("")
+10 SET ZTSTOP=1
End DoDot:1
+11 ;
+12 DO LINE("Total number of Outpatient Encounter entries "_$SELECT(SDMODE=1:"that will be ",1:"")_"processed: "_SDCNT)
DO LINE("")
DO LINE("")
+13 ;
+14 IF SDMODE=2
Begin DoDot:1
+15 DO LINE("Note: Child encounters re-linked as part of parent")
+16 DO LINE(" re-linking process are not listed below nor")
+17 DO LINE(" counted in the total above.")
+18 DO LINE("")
End DoDot:1
+19 ;
+20 ; -- layout of line
+21 DO LINE("Message Format:")
+22 DO LINE(" Piece Description")
+23 DO LINE(" ----- -----------")
+24 DO LINE(" 1 Status of update")
+25 DO LINE(" 2 Internal Entry Number of Outpatient Encounter file")
+26 DO LINE(" 3 Internal Entry Number of Parent Outpatient Encounter file")
+27 DO LINE(" 4 Internal Entry Number of Visit file")
+28 DO LINE(" 5 Patient Name")
+29 DO LINE(" 6 Encounter Date/Time")
+30 DO LINE(" 7 Hospital Location")
+31 DO LINE("")
+32 ;
+33 ; --scan tmp records
+34 FOR I=0:0
SET I=$ORDER(@SDRT@(I))
IF 'I
QUIT
Begin DoDot:1
+35 DO LINE(@SDRT@(I))
End DoDot:1
+36 ;
+37 ; -- set up and fire bulletin
+38 SET XMSUB="Unique Visit ID Cleanup is Complete"
SET XMN=0
+39 SET XMTEXT="^TMP(""SDVISIT MSG"",$J,"
+40 SET XMDUZ=.5
SET XMY(DUZ)=""
+41 DO ^XMD
+42 KILL ^TMP("SDVISIT MSG",$JOB)
+43 KILL SDCOUNT,SDTEXT,XMDUZ,XMN,XMSUB,XMTEXT,XMY,XMZ
+44 QUIT
+45 ;
+46 ;
LINE(TEXT) ; add text to mail message
+1 SET SDCOUNT=SDCOUNT+1
SET ^TMP("SDVISIT MSG",$JOB,SDCOUNT)=TEXT
+2 QUIT
+3 ;
RANGE(SDBEG,SDEND) ; -- select range
+1 NEW SDWITCH,SDT,X1,X2,X,DIR
+2 SET (SDBEG,SDEND)=0
SET SDT=2961001
+3 SET DIR("B")=$$FDATE^VALM1(SDT)
+4 SET DIR(0)="DA"_U_SDT_":"_DT_":EXP"
SET DIR("A")="Select Beginning Date: "
+5 SET DIR("?",1)="Enter a date between "_$$FMTE^XLFDT(SDT)_" to "_$$FMTE^XLFDT(DT)_"."
SET DIR("?")=" "
+6 WRITE !
DO ^DIR
KILL DIR
IF Y'>0
GOTO RANGEQ
SET SDBEG=Y
+7 SET DIR("B")=$$FDATE^VALM1(DT)
+8 SET DIR(0)="DA"_U_SDBEG_":"_DT_":EXP"
SET DIR("A")="Select Ending Date: "
+9 SET DIR("?",1)="Enter a date between "_$$FMTE^XLFDT(SDBEG)_" to "_$$FMTE^XLFDT(DT)_"."
SET DIR("?")=" "
+10 DO ^DIR
KILL DIR
IF Y'>0
GOTO RANGEQ
SET SDEND=Y_".235959"
RANGEQ QUIT SDEND
+1 ;
OK() ; -- ok to continue
+1 NEW DIR,Y
+2 SET DIR("A")="Ok to continue"
+3 SET DIR("B")="NO"
+4 SET DIR(0)="Y"
+5 DO ^DIR
+6 IF Y'=1
SET Y=0
+7 QUIT Y
+8 ;
MODE() ; -- select update mode
+1 NEW DIR,Y
+2 SET DIR(0)="S"_U_"1:Count Only;2:Fix Entries"
+3 SET DIR("A")="Select update mode"
+4 SET DIR("B")="Count Only"
+5 DO ^DIR
+6 IF Y'=1
IF Y'=2
SET Y=0
+7 QUIT Y
+8 ;
