- LEXXGI ;ISL/KER - Global Import (^LEXM) ;04/21/2014
- ;;2.0;LEXICON UTILITY;**4,25,26,27,28,29,46,49,50,41,59,73,80**;Sep 23, 1996;Build 10
- ;
- ;
- ;
- ; Global Variables
- ; ^LEXM
- ;
- ; External References
- ; HOME^%ZIS ICR 10086
- ; ^%ZTLOAD ICR 10063
- ; $$GET1^DIQ ICR 2056
- ; $$FMTE^XLFDT ICR 10103
- ; $$NOW^XLFDT ICR 10103
- ; BMES^XPDUTL ICR 10141
- ; MES^XPDUTL ICR 10141
- ;
- ; NEWed or KILLed by Lexicon Environment Check routine LEX20nn
- ; LEXBUILD Build
- ; LEXFY Fiscal Year
- ; LEXIGHF Global Host File
- ; LEXLREV Revision
- ; LEXPTYPE Patch Type
- ; LEXQTR Quarter
- ; LEXREQP Required Patches/Builds
- ;
- ; NEWed or KILLed by KIDS during the Install of a patch/build
- ; XPDNM Intall Flag
- ;
- EN ; Main Entry Point for Installing LEXM in Post-Installs
- ;
- ; Requires
- ;
- ; LEXBUILD - the name of the patch/build being installed
- ;
- ; Uses
- ;
- ; LEXMSG - If this variable exist, then an install message
- ; message will be set to G.LEXICON
- ;
- ; LEXSHORT - If this variable exist, the install message
- ; will be an abbreviated message, without the
- ; file totals and checksums
- ;
- ; Abbreviated Install Message
- ;
- ; Date and Time Installed
- ; Account where the Data was Installed
- ; Who Installed the Data
- ; The Name of the Build Installed
- ; The Name of the Global Host File
- ; Protocol Invoked
- ; Date and time Protocol was Invoked
- ; Install Start Date/Time
- ; Install Complete Date/Time
- ; Install Elapsed Time
- ;
- ; Long Install Message
- ;
- ; All of the elements above plus:
- ;
- ; File Versions/Revisions
- ; File Checksums
- ; File Record Counts
- ;
- ; LEXNOPRO - If this variable exist, the protocol LEXICAL
- ; SERVICES UPDATE will not be invoked.
- ;
- ; LEXPTYPE - Patch Type
- ; LEXLREV - Revision
- ; LEXREQP - Required Patches/Builds
- ; LEXIGHF - The patch Export Global Host Filename
- ; LEXFY - Fiscal Year
- ; LEXQTR - Quarter
- ; LEXCRE - Import Global Creation Date
- ;
- D IMPORT D KALL^LEXXGI2
- Q
- TASK ; Queue Lexicon Update with Taskman
- N Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,ZTSAVE,ZTQUEUED,ZTREQ S:$D(LEXBUILD) ZTSAVE("LEXBUILD")="" S:$D(LEXMSG) ZTSAVE("LEXMSG")=""
- S:$D(LEXSHORT) ZTSAVE("LEXSHORT")="" S:$D(LEXPTYPE) ZTSAVE("LEXPTYPE")="" S:$D(LEXLREV) ZTSAVE("LEXLREV")="" S:$D(LEXREQP) ZTSAVE("LEXREQP")=""
- S:$D(LEXIGHF) ZTSAVE("LEXIGHF")="" S:$D(LEXFY) ZTSAVE("LEXFY")="" S:$D(LEXQTR) ZTSAVE("LEXQTR")="" S:$D(LEXCRE) ZTSAVE("LEXCRE")=""
- S ZTRTN="EN^LEXXGI",ZTDESC="Importing Updated Lexicon Data" S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS
- Q
- LEXM ; Force Install of LEXM w/o a Post-Install
- N LEXBUILD,LEXBLD,LEXB,LEXBO,LEXCHK,LEXSHORT,LEXTYPE,LEXMSG,LEXPOST,LEXNDS,LEXNOPRO,LEXVER
- S LEXNOPRO="",LEXBO=$G(^LEXM(0,"BUILD")),(LEXBUILD,LEXBLD,LEXB,^LEXM(0,"BUILD"))="LEX*2.0*NN"
- S:$L($G(LEXBO)) (LEXBUILD,LEXBLD,LEXB,^LEXM(0,"BUILD"))=LEXBO
- S LEXSHORT="",LEXTYPE=LEXB S:$L(LEXB) LEXTYPE=LEXTYPE_" (Forced)" S LEXMSG="",LEXPOST=""
- S LEXCHK=+($G(^LEXM(0,"CHECKSUM"))) W !," Running checksum routine on the ^LEXM import global, please wait"
- S LEXNDS=+($G(^LEXM(0,"NODES"))),LEXVER=+($$VC^LEXXGI2(LEXCHK,LEXNDS)) W !
- W:LEXVER>0 !," Checksum is ok",!
- I LEXVER=0 W !!," Import global ^LEXM is missing. Please obtain a copy of ^LEXM before",!," continuing." Q
- I LEXVER<0 D Q
- . I LEXVER'=-3 W !," Unable to verify checksum for import global ^LEXM (possibly corrupt)"
- . I LEXVER=-3 W !," Import global ^LEXM failed checksum"
- . W !!," Please KILL the existing import global ^LEXM from your system and"
- . W !," obtain a new copy of ^LEXM before continuing with the installation."
- D EN
- Q
- IMPORT ; Import Data during a Patch Installation
- S:$D(ZTQUEUED) ZTREQ="@" S:$L($G(LEXPTYPE)) LEXPTYPE=$G(LEXPTYPE) S:$L($G(LEXLREV)) LEXLREV=$G(LEXLREV) S:$L($G(LEXREQP)) LEXREQP=$G(LEXREQP)
- S:$L($G(LEXBUILD)) LEXBUILD=$G(LEXBUILD) S:$L($G(LEXIGHF)) LEXIGHF=$G(LEXIGHF) S:$L($G(LEXFY)) LEXFY=$G(LEXFY)
- S:$L($G(LEXQTR)) LEXQTR=$G(LEXQTR) K LEXSCHG,LEXCHG
- N LEXB,LEXCD,LEXSTR,LEXLAST,LEXRES,LEXSTART,DG,DIC,DICR,DILOCKTM,DIW,XMDUN,XMZ,ZTSK
- S U="^",LEXSTR=$G(LEXPTYPE),LEXB=$G(^LEXM(0,"BUILD")),LEXSTART=$$NOW^XLFDT
- S:$L($G(LEXFY))&($L($G(LEXQTR)))&($L(LEXSTR)) LEXSTR=LEXSTR_" for "_$G(LEXFY)_" "_$G(LEXQTR)_" Quarter"
- S:$L(LEXB) LEXBLD=LEXB S:'$L(LEXBLD)&($L(LEXBUILD)) LEXBLD=LEXBUILD
- I '$L(LEXB)!(LEXB'=LEXBUILD) D
- . N X,LEXBLD I '$L(LEXB) D Q
- . . S X=" Invalid export global, aborting data install" W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X) W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(" ")
- . I '$L(LEXBUILD) D Q
- . . S X=" Undefined KIDS Build, aborting data install" W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X) W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(" ")
- I $L(LEXB)&(LEXB=LEXBUILD) D
- . N LEXFI,LEXID,LEXPROC S X="Installing Data for patch "_LEXB W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X) W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(" ")
- . K LEXSCHG S LEXCHG=0,LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI'>0 D
- . . S LEXID=$S($P(LEXFI,".",1)=80:"ICD",$P(LEXFI,".",1)=81:"CPT",$P(LEXFI,".",1)=757:"LEX",1:"") S:$L(LEXID) LEXSCHG(LEXID)=0,LEXSCHG("LEX")=0
- . S:$D(LEXSCHG("CPT"))!($D(LEXSCHG("ICD"))) LEXSCHG("PRO")="",LEXCHG=1,LEXSCHG(0)=1
- . D LOAD K LEXPROC I '$D(LEXNOPRO) D NOTIFY^LEXXGI2
- . I +($G(DUZ))>0,$L($$GET1^DIQ(200,(+($G(DUZ))_","),.01)) D
- . . D HOME^%ZIS N DIFROM,LEXPRO,LEXPRON,LEXLAST S LEXPRON="LEXICAL SERVICES UPDATE",LEXPRO=$G(^LEXM(0,"PRO"))
- . . D:$D(LEXMSG) POST^LEXXFI
- Q
- LOAD ; Load Data from ^LEXM into IC*/LEX Files
- Q:'$L($G(LEXB)) S:$D(ZTQUEUED) ZTREQ="@"
- N LEXBEG,LEXELP,LEXEND,LEXMSG,LEXOK,LEXFL,LEXTXT
- D:'$D(^LEXM) NF^LEXXGI2 Q:'$D(^LEXM)
- S LEXOK=0 S:$O(^LEXM(0))>0 LEXOK=1 D:'LEXOK IG^LEXXGI2 Q:'LEXOK
- S LEXBEG=$$HACK^LEXXGI2 D FILES^LEXXGI3 S LEXEND=$$HACK^LEXXGI2,LEXELP=$$ELAP^LEXXGI2(LEXBEG,LEXEND)
- S:LEXELP="" LEXELP="00:00:00"
- S LEXRES=$$RESULTS^LEXXII2
- S LEXTXT=" Data Update" S:$L(LEXRES) LEXTXT=LEXTXT_": "_$G(LEXRES)
- D PB^LEXXGI2(LEXTXT)
- D PB^LEXXGI2((" Started: "_$TR($$FMTE^XLFDT(LEXBEG),"@"," ")))
- D TL^LEXXGI2((" Finished: "_$TR($$FMTE^XLFDT(LEXEND),"@"," ")))
- D TL^LEXXGI2((" Elapsed: "_LEXELP))
- Q
- ;
- NOTIFY ; Notify by Protocol - LEXICAL SERVICES UPDATE
- I '$D(LEXNOPRO) D NOTIFY^LEXXGI2,KALL^LEXXGI2
- Q
- AWRD ; Recalculate ASL Cross-Reference in 757.01
- D:$L($T(AWRD^LEXXGI4)) AWRD^LEXXGI4
- Q
- ASL ; Recalculate ASL Cross-Reference in 757.01
- D:$L($T(ASL^LEXXGI4)) ASL^LEXXGI4
- Q
- SUB ; Re-Index Subset file 757.21 (set logic only)
- D:$L($T(SUB^LEXXGI4)) SUB^LEXXGI4
- Q
- SCHG ; Save Change File Changes (for NOTIFY)
- N LEXFI,LEXID K LEXSCHG S LEXCHG=0
- N LEXFI S LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI'>0 D
- . S LEXID=$S(LEXFI=80!(LEXFI=80.1):"ICD",LEXFI=81!(LEXFI=81.1)!(LEXFI=81.2)!(LEXFI=81.3):"CPT",$P(LEXFI,".",1)=757:"LEX",1:"UNK")
- . S LEXSCHG(LEXFI,0)=+($G(^LEXM(LEXFI,0))),LEXSCHG("B",LEXFI)="" S LEXSCHG("C",LEXID,LEXFI)=""
- S:$D(LEXSCHG("C","CPT"))!($D(LEXSCHG("C","ICD"))) LEXSCHG("D","PRO")=""
- S:$D(^LEXM(80))!($D(^LEXM(80.1)))!($D(^LEXM(81)))!($D(^LEXM(81.2)))!($D(^LEXM(81.3)))!($D(LEXSCHG("D","PRO"))) LEXCHG=1,LEXSCHG(0)=1
- Q
- INV(X,Y) ; Protocol Invoked
- N LEXN,LEXP,LEXPD,LEXDT,LEXSAB S LEXSAB=$G(X) Q:"^LEX^ICD^CPT^"'[("^"_LEXSAB_"^") S LEXP=$S(X="LEX":1,X="ICD":2,X="CPT":3,1:"") Q:+LEXP'>0
- S LEXPD=LEXP+(.5),LEXDT=$G(Y) S:$P(LEXDT,",",1)'?7N LEXDT=$$NOW^XLFDT S:'$D(^LEXT(757.2,1,200,0)) ^LEXT(757.2,1,200,0)="^757.201PA^.5^1"
- S ^LEXT(757.2,1,200,.5,0)=.5,^LEXT(757.2,1,200,.5,LEXP)=LEXSAB,^LEXT(757.2,1,200,.5,LEXPD)=LEXN
- Q
- ZTQ ; Taskman Quit
- K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
- Q
- CHECKSUM ; Check ^LEXM Checksum
- D CS^LEXXGI2
- Q
- LEXXGI ;ISL/KER - Global Import (^LEXM) ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**4,25,26,27,28,29,46,49,50,41,59,73,80**;Sep 23, 1996;Build 10
- +2 ;
- +3 ;
- +4 ;
- +5 ; Global Variables
- +6 ; ^LEXM
- +7 ;
- +8 ; External References
- +9 ; HOME^%ZIS ICR 10086
- +10 ; ^%ZTLOAD ICR 10063
- +11 ; $$GET1^DIQ ICR 2056
- +12 ; $$FMTE^XLFDT ICR 10103
- +13 ; $$NOW^XLFDT ICR 10103
- +14 ; BMES^XPDUTL ICR 10141
- +15 ; MES^XPDUTL ICR 10141
- +16 ;
- +17 ; NEWed or KILLed by Lexicon Environment Check routine LEX20nn
- +18 ; LEXBUILD Build
- +19 ; LEXFY Fiscal Year
- +20 ; LEXIGHF Global Host File
- +21 ; LEXLREV Revision
- +22 ; LEXPTYPE Patch Type
- +23 ; LEXQTR Quarter
- +24 ; LEXREQP Required Patches/Builds
- +25 ;
- +26 ; NEWed or KILLed by KIDS during the Install of a patch/build
- +27 ; XPDNM Intall Flag
- +28 ;
- EN ; Main Entry Point for Installing LEXM in Post-Installs
- +1 ;
- +2 ; Requires
- +3 ;
- +4 ; LEXBUILD - the name of the patch/build being installed
- +5 ;
- +6 ; Uses
- +7 ;
- +8 ; LEXMSG - If this variable exist, then an install message
- +9 ; message will be set to G.LEXICON
- +10 ;
- +11 ; LEXSHORT - If this variable exist, the install message
- +12 ; will be an abbreviated message, without the
- +13 ; file totals and checksums
- +14 ;
- +15 ; Abbreviated Install Message
- +16 ;
- +17 ; Date and Time Installed
- +18 ; Account where the Data was Installed
- +19 ; Who Installed the Data
- +20 ; The Name of the Build Installed
- +21 ; The Name of the Global Host File
- +22 ; Protocol Invoked
- +23 ; Date and time Protocol was Invoked
- +24 ; Install Start Date/Time
- +25 ; Install Complete Date/Time
- +26 ; Install Elapsed Time
- +27 ;
- +28 ; Long Install Message
- +29 ;
- +30 ; All of the elements above plus:
- +31 ;
- +32 ; File Versions/Revisions
- +33 ; File Checksums
- +34 ; File Record Counts
- +35 ;
- +36 ; LEXNOPRO - If this variable exist, the protocol LEXICAL
- +37 ; SERVICES UPDATE will not be invoked.
- +38 ;
- +39 ; LEXPTYPE - Patch Type
- +40 ; LEXLREV - Revision
- +41 ; LEXREQP - Required Patches/Builds
- +42 ; LEXIGHF - The patch Export Global Host Filename
- +43 ; LEXFY - Fiscal Year
- +44 ; LEXQTR - Quarter
- +45 ; LEXCRE - Import Global Creation Date
- +46 ;
- +47 DO IMPORT
- DO KALL^LEXXGI2
- +48 QUIT
- TASK ; Queue Lexicon Update with Taskman
- +1 NEW Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,ZTSAVE,ZTQUEUED,ZTREQ
- IF $DATA(LEXBUILD)
- SET ZTSAVE("LEXBUILD")=""
- IF $DATA(LEXMSG)
- SET ZTSAVE("LEXMSG")=""
- +2 IF $DATA(LEXSHORT)
- SET ZTSAVE("LEXSHORT")=""
- IF $DATA(LEXPTYPE)
- SET ZTSAVE("LEXPTYPE")=""
- IF $DATA(LEXLREV)
- SET ZTSAVE("LEXLREV")=""
- IF $DATA(LEXREQP)
- SET ZTSAVE("LEXREQP")=""
- +3 IF $DATA(LEXIGHF)
- SET ZTSAVE("LEXIGHF")=""
- IF $DATA(LEXFY)
- SET ZTSAVE("LEXFY")=""
- IF $DATA(LEXQTR)
- SET ZTSAVE("LEXQTR")=""
- IF $DATA(LEXCRE)
- SET ZTSAVE("LEXCRE")=""
- +4 SET ZTRTN="EN^LEXXGI"
- SET ZTDESC="Importing Updated Lexicon Data"
- SET ZTIO=""
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- DO HOME^%ZIS
- +5 QUIT
- LEXM ; Force Install of LEXM w/o a Post-Install
- +1 NEW LEXBUILD,LEXBLD,LEXB,LEXBO,LEXCHK,LEXSHORT,LEXTYPE,LEXMSG,LEXPOST,LEXNDS,LEXNOPRO,LEXVER
- +2 SET LEXNOPRO=""
- SET LEXBO=$GET(^LEXM(0,"BUILD"))
- SET (LEXBUILD,LEXBLD,LEXB,^LEXM(0,"BUILD"))="LEX*2.0*NN"
- +3 IF $LENGTH($GET(LEXBO))
- SET (LEXBUILD,LEXBLD,LEXB,^LEXM(0,"BUILD"))=LEXBO
- +4 SET LEXSHORT=""
- SET LEXTYPE=LEXB
- IF $LENGTH(LEXB)
- SET LEXTYPE=LEXTYPE_" (Forced)"
- SET LEXMSG=""
- SET LEXPOST=""
- +5 SET LEXCHK=+($GET(^LEXM(0,"CHECKSUM")))
- WRITE !," Running checksum routine on the ^LEXM import global, please wait"
- +6 SET LEXNDS=+($GET(^LEXM(0,"NODES")))
- SET LEXVER=+($$VC^LEXXGI2(LEXCHK,LEXNDS))
- WRITE !
- +7 IF LEXVER>0
- WRITE !," Checksum is ok",!
- +8 IF LEXVER=0
- WRITE !!," Import global ^LEXM is missing. Please obtain a copy of ^LEXM before",!," continuing."
- QUIT
- +9 IF LEXVER<0
- Begin DoDot:1
- +10 IF LEXVER'=-3
- WRITE !," Unable to verify checksum for import global ^LEXM (possibly corrupt)"
- +11 IF LEXVER=-3
- WRITE !," Import global ^LEXM failed checksum"
- +12 WRITE !!," Please KILL the existing import global ^LEXM from your system and"
- +13 WRITE !," obtain a new copy of ^LEXM before continuing with the installation."
- End DoDot:1
- QUIT
- +14 DO EN
- +15 QUIT
- IMPORT ; Import Data during a Patch Installation
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- IF $LENGTH($GET(LEXPTYPE))
- SET LEXPTYPE=$GET(LEXPTYPE)
- IF $LENGTH($GET(LEXLREV))
- SET LEXLREV=$GET(LEXLREV)
- IF $LENGTH($GET(LEXREQP))
- SET LEXREQP=$GET(LEXREQP)
- +2 IF $LENGTH($GET(LEXBUILD))
- SET LEXBUILD=$GET(LEXBUILD)
- IF $LENGTH($GET(LEXIGHF))
- SET LEXIGHF=$GET(LEXIGHF)
- IF $LENGTH($GET(LEXFY))
- SET LEXFY=$GET(LEXFY)
- +3 IF $LENGTH($GET(LEXQTR))
- SET LEXQTR=$GET(LEXQTR)
- KILL LEXSCHG,LEXCHG
- +4 NEW LEXB,LEXCD,LEXSTR,LEXLAST,LEXRES,LEXSTART,DG,DIC,DICR,DILOCKTM,DIW,XMDUN,XMZ,ZTSK
- +5 SET U="^"
- SET LEXSTR=$GET(LEXPTYPE)
- SET LEXB=$GET(^LEXM(0,"BUILD"))
- SET LEXSTART=$$NOW^XLFDT
- +6 IF $LENGTH($GET(LEXFY))&($LENGTH($GET(LEXQTR)))&($LENGTH(LEXSTR))
- SET LEXSTR=LEXSTR_" for "_$GET(LEXFY)_" "_$GET(LEXQTR)_" Quarter"
- +7 IF $LENGTH(LEXB)
- SET LEXBLD=LEXB
- IF '$LENGTH(LEXBLD)&($LENGTH(LEXBUILD))
- SET LEXBLD=LEXBUILD
- +8 IF '$LENGTH(LEXB)!(LEXB'=LEXBUILD)
- Begin DoDot:1
- +9 NEW X,LEXBLD
- IF '$LENGTH(LEXB)
- Begin DoDot:2
- +10 SET X=" Invalid export global, aborting data install"
- IF '$DATA(XPDNM)
- WRITE !!,X
- IF $DATA(XPDNM)
- DO BMES^XPDUTL(X)
- IF '$DATA(XPDNM)
- WRITE !
- IF $DATA(XPDNM)
- DO MES^XPDUTL(" ")
- End DoDot:2
- QUIT
- +11 IF '$LENGTH(LEXBUILD)
- Begin DoDot:2
- +12 SET X=" Undefined KIDS Build, aborting data install"
- IF '$DATA(XPDNM)
- WRITE !!,X
- IF $DATA(XPDNM)
- DO BMES^XPDUTL(X)
- IF '$DATA(XPDNM)
- WRITE !
- IF $DATA(XPDNM)
- DO MES^XPDUTL(" ")
- End DoDot:2
- QUIT
- End DoDot:1
- +13 IF $LENGTH(LEXB)&(LEXB=LEXBUILD)
- Begin DoDot:1
- +14 NEW LEXFI,LEXID,LEXPROC
- SET X="Installing Data for patch "_LEXB
- IF '$DATA(XPDNM)
- WRITE !!,X
- IF $DATA(XPDNM)
- DO BMES^XPDUTL(X)
- IF '$DATA(XPDNM)
- WRITE !
- IF $DATA(XPDNM)
- DO MES^XPDUTL(" ")
- +15 KILL LEXSCHG
- SET LEXCHG=0
- SET LEXFI=0
- FOR
- SET LEXFI=$ORDER(^LEXM(LEXFI))
- IF +LEXFI'>0
- QUIT
- Begin DoDot:2
- +16 SET LEXID=$SELECT($PIECE(LEXFI,".",1)=80:"ICD",$PIECE(LEXFI,".",1)=81:"CPT",$PIECE(LEXFI,".",1)=757:"LEX",1:"")
- IF $LENGTH(LEXID)
- SET LEXSCHG(LEXID)=0
- SET LEXSCHG("LEX")=0
- End DoDot:2
- +17 IF $DATA(LEXSCHG("CPT"))!($DATA(LEXSCHG("ICD")))
- SET LEXSCHG("PRO")=""
- SET LEXCHG=1
- SET LEXSCHG(0)=1
- +18 DO LOAD
- KILL LEXPROC
- IF '$DATA(LEXNOPRO)
- DO NOTIFY^LEXXGI2
- +19 IF +($GET(DUZ))>0
- IF $LENGTH($$GET1^DIQ(200,(+($GET(DUZ))_","),.01))
- Begin DoDot:2
- +20 DO HOME^%ZIS
- NEW DIFROM,LEXPRO,LEXPRON,LEXLAST
- SET LEXPRON="LEXICAL SERVICES UPDATE"
- SET LEXPRO=$GET(^LEXM(0,"PRO"))
- +21 IF $DATA(LEXMSG)
- DO POST^LEXXFI
- End DoDot:2
- End DoDot:1
- +22 QUIT
- LOAD ; Load Data from ^LEXM into IC*/LEX Files
- +1 IF '$LENGTH($GET(LEXB))
- QUIT
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 NEW LEXBEG,LEXELP,LEXEND,LEXMSG,LEXOK,LEXFL,LEXTXT
- +3 IF '$DATA(^LEXM)
- DO NF^LEXXGI2
- IF '$DATA(^LEXM)
- QUIT
- +4 SET LEXOK=0
- IF $ORDER(^LEXM(0))>0
- SET LEXOK=1
- IF 'LEXOK
- DO IG^LEXXGI2
- IF 'LEXOK
- QUIT
- +5 SET LEXBEG=$$HACK^LEXXGI2
- DO FILES^LEXXGI3
- SET LEXEND=$$HACK^LEXXGI2
- SET LEXELP=$$ELAP^LEXXGI2(LEXBEG,LEXEND)
- +6 IF LEXELP=""
- SET LEXELP="00:00:00"
- +7 SET LEXRES=$$RESULTS^LEXXII2
- +8 SET LEXTXT=" Data Update"
- IF $LENGTH(LEXRES)
- SET LEXTXT=LEXTXT_": "_$GET(LEXRES)
- +9 DO PB^LEXXGI2(LEXTXT)
- +10 DO PB^LEXXGI2((" Started: "_$TRANSLATE($$FMTE^XLFDT(LEXBEG),"@"," ")))
- +11 DO TL^LEXXGI2((" Finished: "_$TRANSLATE($$FMTE^XLFDT(LEXEND),"@"," ")))
- +12 DO TL^LEXXGI2((" Elapsed: "_LEXELP))
- +13 QUIT
- +14 ;
- NOTIFY ; Notify by Protocol - LEXICAL SERVICES UPDATE
- +1 IF '$DATA(LEXNOPRO)
- DO NOTIFY^LEXXGI2
- DO KALL^LEXXGI2
- +2 QUIT
- AWRD ; Recalculate ASL Cross-Reference in 757.01
- +1 IF $LENGTH($TEXT(AWRD^LEXXGI4))
- DO AWRD^LEXXGI4
- +2 QUIT
- ASL ; Recalculate ASL Cross-Reference in 757.01
- +1 IF $LENGTH($TEXT(ASL^LEXXGI4))
- DO ASL^LEXXGI4
- +2 QUIT
- SUB ; Re-Index Subset file 757.21 (set logic only)
- +1 IF $LENGTH($TEXT(SUB^LEXXGI4))
- DO SUB^LEXXGI4
- +2 QUIT
- SCHG ; Save Change File Changes (for NOTIFY)
- +1 NEW LEXFI,LEXID
- KILL LEXSCHG
- SET LEXCHG=0
- +2 NEW LEXFI
- SET LEXFI=0
- FOR
- SET LEXFI=$ORDER(^LEXM(LEXFI))
- IF +LEXFI'>0
- QUIT
- Begin DoDot:1
- +3 SET LEXID=$SELECT(LEXFI=80!(LEXFI=80.1):"ICD",LEXFI=81!(LEXFI=81.1)!(LEXFI=81.2)!(LEXFI=81.3):"CPT",$PIECE(LEXFI,".",1)=757:"LEX",1:"UNK")
- +4 SET LEXSCHG(LEXFI,0)=+($GET(^LEXM(LEXFI,0)))
- SET LEXSCHG("B",LEXFI)=""
- SET LEXSCHG("C",LEXID,LEXFI)=""
- End DoDot:1
- +5 IF $DATA(LEXSCHG("C","CPT"))!($DATA(LEXSCHG("C","ICD")))
- SET LEXSCHG("D","PRO")=""
- +6 IF $DATA(^LEXM(80))!($DATA(^LEXM(80.1)))!($DATA(^LEXM(81)))!($DATA(^LEXM(81.2)))!($DATA(^LEXM(81.3)))!($DATA(LEXSCHG("D","PRO")))
- SET LEXCHG=1
- SET LEXSCHG(0)=1
- +7 QUIT
- INV(X,Y) ; Protocol Invoked
- +1 NEW LEXN,LEXP,LEXPD,LEXDT,LEXSAB
- SET LEXSAB=$GET(X)
- IF "^LEX^ICD^CPT^"'[("^"_LEXSAB_"^")
- QUIT
- SET LEXP=$SELECT(X="LEX":1,X="ICD":2,X="CPT":3,1:"")
- IF +LEXP'>0
- QUIT
- +2 SET LEXPD=LEXP+(.5)
- SET LEXDT=$GET(Y)
- IF $PIECE(LEXDT,",",1)'?7N
- SET LEXDT=$$NOW^XLFDT
- IF '$DATA(^LEXT(757.2,1,200,0))
- SET ^LEXT(757.2,1,200,0)="^757.201PA^.5^1"
- +3 SET ^LEXT(757.2,1,200,.5,0)=.5
- SET ^LEXT(757.2,1,200,.5,LEXP)=LEXSAB
- SET ^LEXT(757.2,1,200,.5,LEXPD)=LEXN
- +4 QUIT
- ZTQ ; Taskman Quit
- +1 KILL ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
- +2 QUIT
- CHECKSUM ; Check ^LEXM Checksum
- +1 DO CS^LEXXGI2
- +2 QUIT
