- 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
