Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEX2081A

LEX2081A.m

Go to the documentation of this file.
  1. LEX2081A ;ISL/KER - LEX*2.0*81 Pre/Post Install (cont) ;08/17/2011
  1. ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
  1. ;
  1. ; Global Variables
  1. ; ^LEX(757,
  1. ; ^LEX(757.001
  1. ; ^LEX(757.01
  1. ; ^LEX(757.02
  1. ; ^LEX(757.1
  1. ;
  1. ; External References
  1. ; ^%ZTLOAD ICR 10063
  1. ; ^DIK ICR 10013
  1. ; ENALL^DIK ICR 10013
  1. ; IX1^DIK ICR 10013
  1. ; IX2^DIK ICR 10013
  1. ; MES^XPDUTL ICR 10141
  1. ;
  1. Q
  1. POST ; Post-Install (Continue)
  1. D AVA,AWRD,CHG
  1. Q
  1. CHG ; Changes
  1. D CHG1,CHG2
  1. Q
  1. AVA ; AVA Cross-Reference
  1. N Y,ZTQUEUED,ZTREQ,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1. S ZTRTN="AVAT^LEX2081A",ZTIO="",ZTDTH=$H
  1. S ZTDESC="Lexicon Rebuild AVA Cross-Reference" D ^%ZTLOAD
  1. D MES^XPDUTL(" Checking cross-references")
  1. Q
  1. AVAT ; AVA Cross-Reference (task)
  1. N DIK S DIK="^LEX(757.02,",DIK(1)="2^AVA" D ENALL^DIK
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. AWRD ; AWRD Cross-Reference
  1. N Y,ZTQUEUED,ZTREQ,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1. S ZTRTN="AWRDT^LEX2081A",ZTIO="",ZTDTH=$H
  1. S ZTDESC="Lexicon Rebuild AWRD Cross-Reference" D ^%ZTLOAD
  1. D:+($G(ZTSK))>0 MES^XPDUTL((" A task has been created to rebuild the AWRD cross-reference (#"_+($G(ZTSK))_")"))
  1. D:+($G(ZTSK))'>0 MES^XPDUTL(" Rebuilding the AWRD cross-reference")
  1. Q
  1. AWRDT ; AWRD Cross-Reference (task)
  1. N DIK S DIK="^LEX(757.01,",DIK(1)="2^AWRD" D ENALL^DIK
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. CHG1 ; Change 1 - Sleep Deprivation/Lack of Adequate Sleep
  1. N CODE,DA,DIK,EFF,EX,FQ,MC,OM,SAB,SO
  1. ; Key Words for #331586, "Lack of Adequate Sleep"
  1. S EX=331586
  1. S ^LEX(757.01,EX,5,0)="^757.18^2^2"
  1. S ^LEX(757.01,EX,5,1,0)="SLEEP"
  1. S ^LEX(757.01,EX,5,2,0)="DEPRIVATION"
  1. S DA=EX,DIK="^LEX(757.01," D IX1^DIK
  1. ; Key Words for #111265, "Sleep Deprivation"
  1. S EX=111265
  1. S ^LEX(757.01,EX,5,0)="^757.18^4^4"
  1. S ^LEX(757.01,EX,5,1,0)="LACK"
  1. S ^LEX(757.01,EX,5,2,0)="OF"
  1. S ^LEX(757.01,EX,5,3,0)="SLEEP"
  1. S ^LEX(757.01,EX,5,4,0)="ADEQUATE"
  1. S DA=EX,DIK="^LEX(757.01," D IX1^DIK
  1. ; ICD Code for #111265, "Sleep Deprivation"
  1. S MC=22890,FQ=22890,EX=111265,SO=117782,CODE="V69.4",EFF=3041001,SAB=1
  1. S ^LEX(757.02,SO,0)=EX_"^"_CODE_"^"_SAB_"^"_MC_"^0^^1"
  1. S ^LEX(757.02,SO,4,0)="^757.28D^1^1"
  1. S ^LEX(757.02,SO,4,1,0)=EFF_"^1",DA=SO,DIK="^LEX(757.02," D IX1^DIK
  1. ; Move Expression to New Major Concept as a Synonym
  1. S MC=22890,OM=7112472
  1. S DA=7224943,DIK="^LEX(757.01," D IX2^DIK
  1. S ^LEX(757.01,7224943,0)="Sleep Deprivation"
  1. S ^LEX(757.01,7224943,1)=MC_"^2^D^1"
  1. S DA=7224943,DIK="^LEX(757.01," D IX1^DIK
  1. S DA=7224944,DIK="^LEX(757.01," D IX2^DIK
  1. S ^LEX(757.01,7224944,0)="Sleep Deprivation (finding)"
  1. S ^LEX(757.01,7224944,1)=MC_"^8^D^15"
  1. S DA=7224944,DIK="^LEX(757.01," D IX1^DIK
  1. ; Move Semantic Map to new Major Concept
  1. S DA=7112472,DIK="^LEX(757.1," D IX2^DIK
  1. S ^LEX(757.1,7112472,0)=MC_"^10^71"
  1. S DA=7112472,DIK="^LEX(757.1," D IX1^DIK
  1. ; Move Code to new Major Concept
  1. S DA=7112472,DIK="^LEX(757.02," D IX2^DIK
  1. s ^LEX(757.02,7112472,0)="7224943^130989002^56^"_MC_"^1^^1"
  1. S DA=7112472,DIK="^LEX(757.02," D IX1^DIK
  1. ; Delete old Frequency
  1. I $D(^LEX(757.001,OM,0)) D
  1. . S DA=OM,DIK="^LEX(757.001," D ^DIK
  1. ; Delete old Major Concept Map
  1. I $D(^LEX(757,OM,0)) D
  1. . S DA=OM,DIK="^LEX(757," D ^DIK
  1. Q
  1. CHG2 ; Change 2 - Loss of Consciousness
  1. S MC=7367393,EX=7941742,SO=270124,CODE="780.09",EFF=2781001,SAB=1
  1. ; Frequency
  1. S DA=7367393,DIK="^LEX(757.001," D IX2^DIK
  1. S ^LEX(757.001,7367393,0)="7367393^6^6"
  1. S DA=7367393,DIK="^LEX(757.001," D IX1^DIK
  1. ; Expression
  1. S DA=EX,DIK="^LEX(757.01," D IX2^DIK
  1. S ^LEX(757.01,7941742,0)="Loss of Consciousness"
  1. S DA=EX,DIK="^LEX(757.01," D IX1^DIK
  1. ; Code
  1. S ^LEX(757.02,SO,0)=EX_"^"_CODE_"^"_SAB_"^"_MC_"^0^^1"
  1. S ^LEX(757.02,SO,4,0)="^757.28D^1^1"
  1. S ^LEX(757.02,SO,4,1,0)=EFF_"^1"
  1. S DA=SO,DIK="^LEX(757.02," D IX1^DIK
  1. Q