LEXXGI3 ;ISL/KER - Global Import (Load Data in ^LEXM) ;04/21/2014
;;2.0;LEXICON UTILITY;**59,80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^LEXM( N/A
;
; External References
; $$S^%ZTLOAD ICR 10063
; ^DIM ICR 10016
; $$ROOT^ICDEX ICR 5747
; $$DT^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
;
; Local Variables NEWed or KILLed Elsewhere
;
; LEXFL Array of Files
; LEXOK LEXM exist
; LEXSCHG Changes
; ZTQUEUED Queued Task
; ZTSK Task Number
;
FILES ; Load Data for all files
Q:'$L($G(LEXB)) N LEXHDR,LEXBLD,LEXDAT,LEXFI,LEXFIC,LEXHDRS,LEXLOG,LEXINS,LEXTOTI,LEXTOTN,LEXPER,LEXPRE
S (LEXFI,LEXFIC,LEXHDR,LEXTOTI,LEXTOTN,LEXPER,LEXPRE)=0,LEXBLD=LEXB
S LEXDAT=$P($G(^LEXM(0,"VRRVDT")),"^",1),LEXINS=1
S:+LEXDAT'>0 LEXDAT=$$DT^XLFDT I LEXOK D
. N LEXCRE,LEXL1 S LEXL1="" S LEXCRE=$G(^LEXM(0,"CREATED")) S LEXCRE=$S(+LEXCRE>0:($$MIX^LEXXGI2($$FMTE^XLFDT(LEXCRE))),1:"")
. S:$L($P(LEXCRE,"@",2)) LEXCRE=$P(LEXCRE,"@",1)_" at "_$P(LEXCRE,"@",2) S LEXL1=" Updating files "
. S:$L($G(LEXCRE))&($L($G(LEXL1))) LEXL1=$G(LEXL1)_"using export global created "_$G(LEXCRE)
. D PB^LEXXGI2(LEXL1)
S LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI=0 S LEXTOTN=+($G(LEXTOTN))+($O(^LEXM(LEXFI," "),-1))
S LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI=0 D FILE
Q
FILE ; Load Data for one file
N LEXCF,LEXCHG,LEXCHGS,LEXCNT,LEXFIL,LEXI,LEXID,LEXIEN,LEXL,LEXLC
N LEXMUMPS,LEXNM,LEXRT,LEXS,LEXTOT,LEXTXT,LEXIGL,LEXIGI,LEXIGF,LEXIGT
N LEXIGD,LEXIGO,LEXBEG,LEXEND,LEXELP,LEXFB
S LEXFB=$G(^LEXM(+LEXFI,0,"BUILD")),LEXIGO=0,LEXBEG=$$HACK^LEXXGI2
S (LEXCNT,LEXLC,LEXI)=0,LEXL=68,LEXFIC=LEXFIC+1 I LEXOK D
. N LEXB,LEXFID,LEXNM,LEXVR,LEXRV,LEXDT,LEXL1,LEXL2 S (LEXL1,LEXL2)="",LEXFID=$P(LEXFI,".",1)
. Q:+LEXFID'>0 Q:$D(LEXHDRS(+LEXFID)) S LEXHDRS(LEXFID)="" S:+LEXFI=81!(+LEXFI=81.3) LEXHDRS(81)="",LEXHDRS(81.3)=""
. S:LEXFID=80 LEXNM="ICD-9-CM" S:LEXFID=81 LEXNM="CPT-4/HCPCS" S:LEXFID=757 LEXNM="Lexicon" S LEXB=$G(^LEXM(LEXFI,0,"BUILD"))
. S LEXVR=$G(^LEXM(LEXFI,0,"VR")),LEXRV=$G(^LEXM(LEXFI,0,"VRRV")),LEXDT=$$MIX^LEXXGI2($$FMTE^XLFDT($P(LEXRV,"^",2))),LEXRV=$P(LEXRV,"^",1)
. S LEXL1="Updating "_LEXNM S:$L(LEXB) LEXL1=LEXL1_" with patch/build "_LEXB S:$L(LEXVR) LEXL2=" To version "_LEXVR
. S:$L(LEXVR)&($L(LEXRV)) LEXL2=LEXL2_" revision "_LEXRV S:$L(LEXVR)&($L(LEXRV))&($L(LEXDT)) LEXL2=LEXL2_" dated "_LEXDT
. S:$L(LEXL1) LEXL1=" "_LEXL1 S:$L(LEXL2) LEXL2=" "_LEXL2 D BL^LEXXGI2 D:$L(LEXL1) TL^LEXXGI2(LEXL1) D:$L(LEXL2) TL^LEXXGI2(LEXL2),BL^LEXXGI2
S LEXTOT=+($G(^LEXM(LEXFI,0))) G:LEXTOT=0 FILEQ
S LEXNM=$G(^LEXM(LEXFI,0,"NM"))
I $L(LEXNM),$$UP^LEXXGI2(LEXNM)'["FILE" S LEXNM=LEXNM_" FILE"
S:$L(LEXNM) LEXNM=$$MIX^LEXXGI2(LEXNM) S LEXCHG=$G(^LEXM(LEXFI,0))
S LEXTXT=" "_LEXNM,LEXTXT=LEXTXT_$J("",(40-$L(LEXTXT)))_LEXFI
D:LEXFIC=1 PB^LEXXGI2(LEXTXT) D:LEXFIC'=1 TL^LEXXGI2(LEXTXT)
S LEXS=+(LEXTOT\LEXL) S:LEXS=0 LEXS=1 W:+($O(^LEXM(LEXFI,0)))>0 !," "
D UPCHG^LEXXGI2 F S LEXI=$O(^LEXM(LEXFI,LEXI)) Q:+LEXI=0 D
. S LEXCNT=LEXCNT+1,LEXMUMPS=$G(^LEXM(LEXFI,LEXI))
. I LEXCNT'<LEXS S LEXLC=LEXLC+1 W:LEXLC'>LEXL "." S LEXCNT=0
. S LEXRT=$P(LEXMUMPS,"^",2),LEXFIL=""
. S:LEXMUMPS["^LEX("!(LEXMUMPS["^LEXT(")!(LEXMUMPS["^LEXC(") LEXFIL=+($P(LEXRT,"(",2)),LEXFL(+($P(LEXRT,"(",2)))=""
. S:LEXMUMPS[$$ROOT^ICDEX(80) LEXFIL=80,LEXFL(80)=""
. S:LEXMUMPS[$$ROOT^ICDEX(80.1) LEXFIL=80.1,LEXFL(80.1)=""
. S:LEXMUMPS["^ICPT(" LEXFIL=81,LEXFL(81)=""
. S:LEXMUMPS["^DIC(81.3" LEXFIL=81.3,LEXFL(81.3)=""
. S:LEXMUMPS["^DIC(81.2" LEXFIL=81.2,LEXFL(81.2)=""
. S:+LEXFIL>0 LEXSCHG(+LEXFIL,0)=""
. I $L(LEXMUMPS) D
. . X LEXMUMPS S LEXIGO=1
. . S LEXTOTI=+($G(LEXTOTI))+1 I +($G(LEXTOTN))>0,+($G(LEXTOTI))>0,$D(ZTQUEUED),+($G(ZTSK))>0 D
. . . N LEXT,LEXTSK S (LEXT,LEXPER)=(+($G(LEXTOTI))/+($G(LEXTOTN)))*100 Q:+LEXPER-(+($G(LEXPRE)))'>2 S LEXPRE=+($G(LEXPER))
. . . S LEXPER=$J(LEXPER,6,2) I +LEXT>0 S LEXPER=LEXPER_"% complete" S LEXTSK=$$S^%ZTLOAD(LEXPER)
I +($G(LEXIGO))>0 D
. S LEXEND=$$HACK^LEXXGI2 S LEXELP=$$ELAP^LEXXGI2(LEXBEG,LEXEND) S:LEXELP="" LEXELP="00:00:00"
FILEQ ; Load Data for one file - QUIT
Q
LEXXGI3 ;ISL/KER - Global Import (Load Data in ^LEXM) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**59,80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^LEXM( N/A
+5 ;
+6 ; External References
+7 ; $$S^%ZTLOAD ICR 10063
+8 ; ^DIM ICR 10016
+9 ; $$ROOT^ICDEX ICR 5747
+10 ; $$DT^XLFDT ICR 10103
+11 ; $$FMTE^XLFDT ICR 10103
+12 ;
+13 ; Local Variables NEWed or KILLed Elsewhere
+14 ;
+15 ; LEXFL Array of Files
+16 ; LEXOK LEXM exist
+17 ; LEXSCHG Changes
+18 ; ZTQUEUED Queued Task
+19 ; ZTSK Task Number
+20 ;
FILES ; Load Data for all files
+1 IF '$LENGTH($GET(LEXB))
QUIT
NEW LEXHDR,LEXBLD,LEXDAT,LEXFI,LEXFIC,LEXHDRS,LEXLOG,LEXINS,LEXTOTI,LEXTOTN,LEXPER,LEXPRE
+2 SET (LEXFI,LEXFIC,LEXHDR,LEXTOTI,LEXTOTN,LEXPER,LEXPRE)=0
SET LEXBLD=LEXB
+3 SET LEXDAT=$PIECE($GET(^LEXM(0,"VRRVDT")),"^",1)
SET LEXINS=1
+4 IF +LEXDAT'>0
SET LEXDAT=$$DT^XLFDT
IF LEXOK
Begin DoDot:1
+5 NEW LEXCRE,LEXL1
SET LEXL1=""
SET LEXCRE=$GET(^LEXM(0,"CREATED"))
SET LEXCRE=$SELECT(+LEXCRE>0:($$MIX^LEXXGI2($$FMTE^XLFDT(LEXCRE))),1:"")
+6 IF $LENGTH($PIECE(LEXCRE,"@",2))
SET LEXCRE=$PIECE(LEXCRE,"@",1)_" at "_$PIECE(LEXCRE,"@",2)
SET LEXL1=" Updating files "
+7 IF $LENGTH($GET(LEXCRE))&($LENGTH($GET(LEXL1)))
SET LEXL1=$GET(LEXL1)_"using export global created "_$GET(LEXCRE)
+8 DO PB^LEXXGI2(LEXL1)
End DoDot:1
+9 SET LEXFI=0
FOR
SET LEXFI=$ORDER(^LEXM(LEXFI))
IF +LEXFI=0
QUIT
SET LEXTOTN=+($GET(LEXTOTN))+($ORDER(^LEXM(LEXFI," "),-1))
+10 SET LEXFI=0
FOR
SET LEXFI=$ORDER(^LEXM(LEXFI))
IF +LEXFI=0
QUIT
DO FILE
+11 QUIT
FILE ; Load Data for one file
+1 NEW LEXCF,LEXCHG,LEXCHGS,LEXCNT,LEXFIL,LEXI,LEXID,LEXIEN,LEXL,LEXLC
+2 NEW LEXMUMPS,LEXNM,LEXRT,LEXS,LEXTOT,LEXTXT,LEXIGL,LEXIGI,LEXIGF,LEXIGT
+3 NEW LEXIGD,LEXIGO,LEXBEG,LEXEND,LEXELP,LEXFB
+4 SET LEXFB=$GET(^LEXM(+LEXFI,0,"BUILD"))
SET LEXIGO=0
SET LEXBEG=$$HACK^LEXXGI2
+5 SET (LEXCNT,LEXLC,LEXI)=0
SET LEXL=68
SET LEXFIC=LEXFIC+1
IF LEXOK
Begin DoDot:1
+6 NEW LEXB,LEXFID,LEXNM,LEXVR,LEXRV,LEXDT,LEXL1,LEXL2
SET (LEXL1,LEXL2)=""
SET LEXFID=$PIECE(LEXFI,".",1)
+7 IF +LEXFID'>0
QUIT
IF $DATA(LEXHDRS(+LEXFID))
QUIT
SET LEXHDRS(LEXFID)=""
IF +LEXFI=81!(+LEXFI=81.3)
SET LEXHDRS(81)=""
SET LEXHDRS(81.3)=""
+8 IF LEXFID=80
SET LEXNM="ICD-9-CM"
IF LEXFID=81
SET LEXNM="CPT-4/HCPCS"
IF LEXFID=757
SET LEXNM="Lexicon"
SET LEXB=$GET(^LEXM(LEXFI,0,"BUILD"))
+9 SET LEXVR=$GET(^LEXM(LEXFI,0,"VR"))
SET LEXRV=$GET(^LEXM(LEXFI,0,"VRRV"))
SET LEXDT=$$MIX^LEXXGI2($$FMTE^XLFDT($PIECE(LEXRV,"^",2)))
SET LEXRV=$PIECE(LEXRV,"^",1)
+10 SET LEXL1="Updating "_LEXNM
IF $LENGTH(LEXB)
SET LEXL1=LEXL1_" with patch/build "_LEXB
IF $LENGTH(LEXVR)
SET LEXL2=" To version "_LEXVR
+11 IF $LENGTH(LEXVR)&($LENGTH(LEXRV))
SET LEXL2=LEXL2_" revision "_LEXRV
IF $LENGTH(LEXVR)&($LENGTH(LEXRV))&($LENGTH(LEXDT))
SET LEXL2=LEXL2_" dated "_LEXDT
+12 IF $LENGTH(LEXL1)
SET LEXL1=" "_LEXL1
IF $LENGTH(LEXL2)
SET LEXL2=" "_LEXL2
DO BL^LEXXGI2
IF $LENGTH(LEXL1)
DO TL^LEXXGI2(LEXL1)
IF $LENGTH(LEXL2)
DO TL^LEXXGI2(LEXL2)
DO BL^LEXXGI2
End DoDot:1
+13 SET LEXTOT=+($GET(^LEXM(LEXFI,0)))
IF LEXTOT=0
GOTO FILEQ
+14 SET LEXNM=$GET(^LEXM(LEXFI,0,"NM"))
+15 IF $LENGTH(LEXNM)
IF $$UP^LEXXGI2(LEXNM)'["FILE"
SET LEXNM=LEXNM_" FILE"
+16 IF $LENGTH(LEXNM)
SET LEXNM=$$MIX^LEXXGI2(LEXNM)
SET LEXCHG=$GET(^LEXM(LEXFI,0))
+17 SET LEXTXT=" "_LEXNM
SET LEXTXT=LEXTXT_$JUSTIFY("",(40-$LENGTH(LEXTXT)))_LEXFI
+18 IF LEXFIC=1
DO PB^LEXXGI2(LEXTXT)
IF LEXFIC'=1
DO TL^LEXXGI2(LEXTXT)
+19 SET LEXS=+(LEXTOT\LEXL)
IF LEXS=0
SET LEXS=1
IF +($ORDER(^LEXM(LEXFI,0)))>0
WRITE !," "
+20 DO UPCHG^LEXXGI2
FOR
SET LEXI=$ORDER(^LEXM(LEXFI,LEXI))
IF +LEXI=0
QUIT
Begin DoDot:1
+21 SET LEXCNT=LEXCNT+1
SET LEXMUMPS=$GET(^LEXM(LEXFI,LEXI))
+22 IF LEXCNT'<LEXS
SET LEXLC=LEXLC+1
IF LEXLC'>LEXL
WRITE "."
SET LEXCNT=0
+23 SET LEXRT=$PIECE(LEXMUMPS,"^",2)
SET LEXFIL=""
+24 IF LEXMUMPS["^LEX("!(LEXMUMPS["^LEXT(")!(LEXMUMPS["^LEXC(")
SET LEXFIL=+($PIECE(LEXRT,"(",2))
SET LEXFL(+($PIECE(LEXRT,"(",2)))=""
+25 IF LEXMUMPS[$$ROOT^ICDEX(80)
SET LEXFIL=80
SET LEXFL(80)=""
+26 IF LEXMUMPS[$$ROOT^ICDEX(80.1)
SET LEXFIL=80.1
SET LEXFL(80.1)=""
+27 IF LEXMUMPS["^ICPT("
SET LEXFIL=81
SET LEXFL(81)=""
+28 IF LEXMUMPS["^DIC(81.3"
SET LEXFIL=81.3
SET LEXFL(81.3)=""
+29 IF LEXMUMPS["^DIC(81.2"
SET LEXFIL=81.2
SET LEXFL(81.2)=""
+30 IF +LEXFIL>0
SET LEXSCHG(+LEXFIL,0)=""
+31 IF $LENGTH(LEXMUMPS)
Begin DoDot:2
+32 XECUTE LEXMUMPS
SET LEXIGO=1
+33 SET LEXTOTI=+($GET(LEXTOTI))+1
IF +($GET(LEXTOTN))>0
IF +($GET(LEXTOTI))>0
IF $DATA(ZTQUEUED)
IF +($GET(ZTSK))>0
Begin DoDot:3
+34 NEW LEXT,LEXTSK
SET (LEXT,LEXPER)=(+($GET(LEXTOTI))/+($GET(LEXTOTN)))*100
IF +LEXPER-(+($GET(LEXPRE)))'>2
QUIT
SET LEXPRE=+($GET(LEXPER))
+35 SET LEXPER=$JUSTIFY(LEXPER,6,2)
IF +LEXT>0
SET LEXPER=LEXPER_"% complete"
SET LEXTSK=$$S^%ZTLOAD(LEXPER)
End DoDot:3
End DoDot:2
End DoDot:1
+36 IF +($GET(LEXIGO))>0
Begin DoDot:1
+37 SET LEXEND=$$HACK^LEXXGI2
SET LEXELP=$$ELAP^LEXXGI2(LEXBEG,LEXEND)
IF LEXELP=""
SET LEXELP="00:00:00"
End DoDot:1
FILEQ ; Load Data for one file - QUIT
+1 QUIT
