- LEXXFQ ;ISL/KER - Set Frequencies in 757.001 ;04/21/2014
- ;;2.0;LEXICON UTILITY;**4,25,73,80**;Sep 23, 1996;Build 10
- ;
- ; Global Variables
- ; ^LEX(757.001) N/A
- ;
- ; External References
- ; $$FMDIFF^XLFDT ICR 10103
- ; $$FMTE^XLFDT ICR 10103
- ; HOME^%ZIS ICR 10086
- ; NOW^%DTC ICR 10000
- ; ^%ZTLOAD ICR 10063
- ;
- Q
- EN ; Update term frequencies when not found (at site)
- S ZTRTN="UP^LEXXFQ",ZTDESC="Update Term Frequency in file 757.001"
- S ZTIO="",ZTDTH=$H
- D ^%ZTLOAD,HOME^%ZIS
- K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
- Q
- EN2 ; Reset term frequencies to export values (at CIOFO)
- S ZTRTN="RE^LEXXFQ",ZTDESC="Reset Term Frequencies in file 757.001"
- S ZTIO="",ZTDTH=$H
- D ^%ZTLOAD,HOME^%ZIS
- K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
- Q
- CHK ; Check frequencies (at site or IRMFO)
- N LEXI,LEXC S (LEXI,LEXC)=0
- F S LEXI=$O(^LEX(757,LEXI)) Q:+LEXI=0 S:'$D(^LEX(757.001,LEXI)) LEXC=LEXC+1
- I '$D(ZTQUEUED) D
- .W:LEXC>0 !!,LEXC," Concepts do not have frequencies set",!!
- .W:LEXC'>0 !!,"All concepts have frequencies set",!!
- Q
- UP ; Update frequencies
- S:$D(ZTQUEUED) ZTREQ="@"
- N LEX1,LEX2,LEXU,LEXUC,LEXDC,LEXMA,LEXT,LEXL,LEXH
- S (LEXDC,LEXU,LEXUC,LEXT,LEXL,LEXMA)=0,LEXH="."
- S LEX1=$$HACK
- I '$D(ZTQUEUED) D
- .W !!,"Initializing Global",!," Start: ",$P(LEX1,"^",2),!," "
- F S LEXMA=$O(^LEX(757,LEXMA)) Q:+LEXMA=0 D
- . S:'$D(^LEX(757.001,LEXMA,0)) LEXH="+" S LEXT=LEXT+1,LEXL=LEXMA
- . W:'$D(ZTQUEUED)&(LEXT#1000=0) LEXH S:LEXT#1000=0 LEXH=".",LEXDC=LEXDC+1
- . W:'$D(ZTQUEUED)&(LEXDC#76=0)&(LEXDC>0)&(LEXT#1000=0) !," "
- . I '$D(^LEX(757.001,LEXMA,0)) D SET S LEXUC=LEXUC+1
- W:'$D(ZTQUEUED) LEXH
- S:LEXT>0 $P(^LEX(757.001,0),"^",4)=LEXT
- S:LEXL>0 $P(^LEX(757.001,0),"^",3)=LEXL S:$D(ZTQUEUED) ZTREQ="@"
- S LEX2=$$HACK
- I '$D(ZTQUEUED) D
- .W !," Finished: ",$P(LEX2,"^",2)
- .W !," Time: ",$$TIME($P(LEX1,"^",1),$P(LEX2,"^",1)),!
- Q
- RE ; Reset frequencies
- S:$D(ZTQUEUED) ZTREQ="@"
- N LEXMA,LEXT,LEXL S (LEXT,LEXL,LEXMA)=0
- F S LEXMA=$O(^LEX(757,LEXMA)) Q:+LEXMA=0 S LEXT=LEXT+1,LEXL=LEXMA D SET
- S:LEXT>0 $P(^LEX(757.001,0),"^",4)=LEXT
- S:LEXL>0 $P(^LEX(757.001,0),"^",3)=LEXL S:$D(ZTQUEUED) ZTREQ="@" Q
- SET ; Set frequency
- N DIK,DIC,DA,LEXFQ
- S LEXMA=+($G(LEXMA))
- Q:'$D(^LEX(757,LEXMA,0))
- S DIC="^LEX(757.001,",DA=LEXMA,LEXFQ=+($$FQ(LEXMA))
- D:$D(^LEX(757.001,DA)) KILL^LEXNDX2
- S ^LEX(757.001,LEXMA,0)=LEXMA_"^"_LEXFQ_"^"_LEXFQ
- D SET^LEXNDX2
- Q
- FQ(LEXX) ; Frequency
- ;
- ; LEXSAB Source Abbreviation
- ; LEXSMC Semantic Class
- ; LEXNUR Nursing Class
- ; LEXBEH Behavior/Mental Health Class
- ; LEXPRO Procedural Class
- ; LEXDIA Diagnostic Class
- ; LEXSA IEN Source Code (ICD, CPT, DSM, etc)
- ; LEXMC IEN Major Concept
- ; LEXSO Code
- ;
- N LEXMC S LEXMC=+($G(LEXX)) Q:'$D(^LEX(757,LEXMC,0)) 0 Q:LEXMC<3 0
- N LEXSA,LEXSAB,LEXSMC,LEXNUR,LEXBEH,LEXPRO,LEXDIA,LEXSN,LEXSO,LEXSR
- S (LEXSA,LEXNUR,LEXBEH,LEXPRO,LEXDIA)=0
- F S LEXSA=$O(^LEX(757.02,"AMC",LEXMC,LEXSA)) Q:+LEXSA=0 D
- . S LEXSN=$G(^LEX(757.02,LEXSA,0))
- . S LEXSO=$P(LEXSN,"^",2),LEXSR=$P(LEXSN,"^",3)
- . Q:+$$STATCHK^LEXSRC2(LEXSO,,,LEXSR)=0
- . S LEXSAB=+($P($G(^LEX(757.02,LEXSA,0)),"^",3)) Q:LEXSAB=0
- . Q:LEXSAB>15 S:LEXSAB=1 LEXDIA=1
- . S:LEXSAB>1&(LEXSAB<5) LEXPRO=1
- . S:LEXSAB>4&(LEXSAB<7) LEXBEH=1
- . S:LEXSAB>10&(LEXSAB<16) LEXNUR=1
- S LEXSMC=$$SM(LEXMC),LEXX=0 I LEXDIA=1 S LEXX=4 Q LEXX
- I LEXBEH=1!(LEXSMC=1) S LEXX=3 Q LEXX
- I LEXPRO=1 S LEXX=2 Q LEXX
- I LEXNUR=1 S LEXX=1 Q LEXX
- Q LEXX
- SM(LEXX) ; Semantic Map (757.1)
- N LEXMC,LEXCL,LEXSA
- S LEXSA=0,LEXMC=+($G(LEXX)),LEXX=0
- Q:'$D(^LEX(757,LEXMC,0)) 0
- F S LEXSA=$O(^LEX(757.1,"B",LEXMC,LEXSA)) Q:+LEXSA=0 D
- .S LEXCL=+($P($G(^LEX(757.1,LEXSA,0)),"^",2))
- .I LEXCL=3!(LEXCL=6) S LEXX=1
- Q LEXX
- HACK(LEXX) ; Time Hack
- N X,%,%H,%I
- N HACK D NOW^%DTC S HACK=$$FMTE^XLFDT(%,1),HACK=$TR(HACK,"@"," ")
- S LEXX=%_"^"_HACK Q LEXX
- TIME(LEXBEG,LEXEND) ; Elapsed time from begining to end
- S LEXBEG=+($G(LEXBEG)) Q:LEXBEG=0 "" S LEXEND=+($G(LEXEND)) Q:LEXBEG=0 ""
- S LEXBEG=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3) S:$L($P(LEXBEG,":",1))=1 $P(LEXBEG,":",1)="0"_$P(LEXBEG,":",1) S LEXBEG=$TR(LEXBEG," ","0")
- Q LEXBEG
- LEXXFQ ;ISL/KER - Set Frequencies in 757.001 ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**4,25,73,80**;Sep 23, 1996;Build 10
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEX(757.001) N/A
- +5 ;
- +6 ; External References
- +7 ; $$FMDIFF^XLFDT ICR 10103
- +8 ; $$FMTE^XLFDT ICR 10103
- +9 ; HOME^%ZIS ICR 10086
- +10 ; NOW^%DTC ICR 10000
- +11 ; ^%ZTLOAD ICR 10063
- +12 ;
- +13 QUIT
- EN ; Update term frequencies when not found (at site)
- +1 SET ZTRTN="UP^LEXXFQ"
- SET ZTDESC="Update Term Frequency in file 757.001"
- +2 SET ZTIO=""
- SET ZTDTH=$HOROLOG
- +3 DO ^%ZTLOAD
- DO HOME^%ZIS
- +4 KILL Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
- +5 QUIT
- EN2 ; Reset term frequencies to export values (at CIOFO)
- +1 SET ZTRTN="RE^LEXXFQ"
- SET ZTDESC="Reset Term Frequencies in file 757.001"
- +2 SET ZTIO=""
- SET ZTDTH=$HOROLOG
- +3 DO ^%ZTLOAD
- DO HOME^%ZIS
- +4 KILL Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
- +5 QUIT
- CHK ; Check frequencies (at site or IRMFO)
- +1 NEW LEXI,LEXC
- SET (LEXI,LEXC)=0
- +2 FOR
- SET LEXI=$ORDER(^LEX(757,LEXI))
- IF +LEXI=0
- QUIT
- IF '$DATA(^LEX(757.001,LEXI))
- SET LEXC=LEXC+1
- +3 IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +4 IF LEXC>0
- WRITE !!,LEXC," Concepts do not have frequencies set",!!
- +5 IF LEXC'>0
- WRITE !!,"All concepts have frequencies set",!!
- End DoDot:1
- +6 QUIT
- UP ; Update frequencies
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 NEW LEX1,LEX2,LEXU,LEXUC,LEXDC,LEXMA,LEXT,LEXL,LEXH
- +3 SET (LEXDC,LEXU,LEXUC,LEXT,LEXL,LEXMA)=0
- SET LEXH="."
- +4 SET LEX1=$$HACK
- +5 IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +6 WRITE !!,"Initializing Global",!," Start: ",$PIECE(LEX1,"^",2),!," "
- End DoDot:1
- +7 FOR
- SET LEXMA=$ORDER(^LEX(757,LEXMA))
- IF +LEXMA=0
- QUIT
- Begin DoDot:1
- +8 IF '$DATA(^LEX(757.001,LEXMA,0))
- SET LEXH="+"
- SET LEXT=LEXT+1
- SET LEXL=LEXMA
- +9 IF '$DATA(ZTQUEUED)&(LEXT#1000=0)
- WRITE LEXH
- IF LEXT#1000=0
- SET LEXH="."
- SET LEXDC=LEXDC+1
- +10 IF '$DATA(ZTQUEUED)&(LEXDC#76=0)&(LEXDC>0)&(LEXT#1000=0)
- WRITE !," "
- +11 IF '$DATA(^LEX(757.001,LEXMA,0))
- DO SET
- SET LEXUC=LEXUC+1
- End DoDot:1
- +12 IF '$DATA(ZTQUEUED)
- WRITE LEXH
- +13 IF LEXT>0
- SET $PIECE(^LEX(757.001,0),"^",4)=LEXT
- +14 IF LEXL>0
- SET $PIECE(^LEX(757.001,0),"^",3)=LEXL
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +15 SET LEX2=$$HACK
- +16 IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +17 WRITE !," Finished: ",$PIECE(LEX2,"^",2)
- +18 WRITE !," Time: ",$$TIME($PIECE(LEX1,"^",1),$PIECE(LEX2,"^",1)),!
- End DoDot:1
- +19 QUIT
- RE ; Reset frequencies
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 NEW LEXMA,LEXT,LEXL
- SET (LEXT,LEXL,LEXMA)=0
- +3 FOR
- SET LEXMA=$ORDER(^LEX(757,LEXMA))
- IF +LEXMA=0
- QUIT
- SET LEXT=LEXT+1
- SET LEXL=LEXMA
- DO SET
- +4 IF LEXT>0
- SET $PIECE(^LEX(757.001,0),"^",4)=LEXT
- +5 IF LEXL>0
- SET $PIECE(^LEX(757.001,0),"^",3)=LEXL
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- SET ; Set frequency
- +1 NEW DIK,DIC,DA,LEXFQ
- +2 SET LEXMA=+($GET(LEXMA))
- +3 IF '$DATA(^LEX(757,LEXMA,0))
- QUIT
- +4 SET DIC="^LEX(757.001,"
- SET DA=LEXMA
- SET LEXFQ=+($$FQ(LEXMA))
- +5 IF $DATA(^LEX(757.001,DA))
- DO KILL^LEXNDX2
- +6 SET ^LEX(757.001,LEXMA,0)=LEXMA_"^"_LEXFQ_"^"_LEXFQ
- +7 DO SET^LEXNDX2
- +8 QUIT
- FQ(LEXX) ; Frequency
- +1 ;
- +2 ; LEXSAB Source Abbreviation
- +3 ; LEXSMC Semantic Class
- +4 ; LEXNUR Nursing Class
- +5 ; LEXBEH Behavior/Mental Health Class
- +6 ; LEXPRO Procedural Class
- +7 ; LEXDIA Diagnostic Class
- +8 ; LEXSA IEN Source Code (ICD, CPT, DSM, etc)
- +9 ; LEXMC IEN Major Concept
- +10 ; LEXSO Code
- +11 ;
- +12 NEW LEXMC
- SET LEXMC=+($GET(LEXX))
- IF '$DATA(^LEX(757,LEXMC,0))
- QUIT 0
- IF LEXMC<3
- QUIT 0
- +13 NEW LEXSA,LEXSAB,LEXSMC,LEXNUR,LEXBEH,LEXPRO,LEXDIA,LEXSN,LEXSO,LEXSR
- +14 SET (LEXSA,LEXNUR,LEXBEH,LEXPRO,LEXDIA)=0
- +15 FOR
- SET LEXSA=$ORDER(^LEX(757.02,"AMC",LEXMC,LEXSA))
- IF +LEXSA=0
- QUIT
- Begin DoDot:1
- +16 SET LEXSN=$GET(^LEX(757.02,LEXSA,0))
- +17 SET LEXSO=$PIECE(LEXSN,"^",2)
- SET LEXSR=$PIECE(LEXSN,"^",3)
- +18 IF +$$STATCHK^LEXSRC2(LEXSO,,,LEXSR)=0
- QUIT
- +19 SET LEXSAB=+($PIECE($GET(^LEX(757.02,LEXSA,0)),"^",3))
- IF LEXSAB=0
- QUIT
- +20 IF LEXSAB>15
- QUIT
- IF LEXSAB=1
- SET LEXDIA=1
- +21 IF LEXSAB>1&(LEXSAB<5)
- SET LEXPRO=1
- +22 IF LEXSAB>4&(LEXSAB<7)
- SET LEXBEH=1
- +23 IF LEXSAB>10&(LEXSAB<16)
- SET LEXNUR=1
- End DoDot:1
- +24 SET LEXSMC=$$SM(LEXMC)
- SET LEXX=0
- IF LEXDIA=1
- SET LEXX=4
- QUIT LEXX
- +25 IF LEXBEH=1!(LEXSMC=1)
- SET LEXX=3
- QUIT LEXX
- +26 IF LEXPRO=1
- SET LEXX=2
- QUIT LEXX
- +27 IF LEXNUR=1
- SET LEXX=1
- QUIT LEXX
- +28 QUIT LEXX
- SM(LEXX) ; Semantic Map (757.1)
- +1 NEW LEXMC,LEXCL,LEXSA
- +2 SET LEXSA=0
- SET LEXMC=+($GET(LEXX))
- SET LEXX=0
- +3 IF '$DATA(^LEX(757,LEXMC,0))
- QUIT 0
- +4 FOR
- SET LEXSA=$ORDER(^LEX(757.1,"B",LEXMC,LEXSA))
- IF +LEXSA=0
- QUIT
- Begin DoDot:1
- +5 SET LEXCL=+($PIECE($GET(^LEX(757.1,LEXSA,0)),"^",2))
- +6 IF LEXCL=3!(LEXCL=6)
- SET LEXX=1
- End DoDot:1
- +7 QUIT LEXX
- HACK(LEXX) ; Time Hack
- +1 NEW X,%,%H,%I
- +2 NEW HACK
- DO NOW^%DTC
- SET HACK=$$FMTE^XLFDT(%,1)
- SET HACK=$TRANSLATE(HACK,"@"," ")
- +3 SET LEXX=%_"^"_HACK
- QUIT LEXX
- TIME(LEXBEG,LEXEND) ; Elapsed time from begining to end
- +1 SET LEXBEG=+($GET(LEXBEG))
- IF LEXBEG=0
- QUIT ""
- SET LEXEND=+($GET(LEXEND))
- IF LEXBEG=0
- QUIT ""
- +2 SET LEXBEG=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- IF $LENGTH($PIECE(LEXBEG,"
- SET $PIECE(LEXBEG,":",1)="0"_$PIECE(LEXBEG,":",1)
- SET LEXBEG=$TRANSLATE(LEXBEG," ","0")
- +3 QUIT LEXBEG
