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

ADE697B.m

Go to the documentation of this file. 
  1. ADE697B ;IHS/HQW/MJL - DENTAL TABLE UPDATES;  [ 03/24/1999   8:35 AM ]
  1.  ;;6.0;ADE;;APRIL 1999
  1.  ;
  1.  ;
  1. OPSITE ;EP Dental Operative Site Changes
  1.  ;
  1.  N ADET,ADEFROM,ADETO,ADEJ,ADELINE,ADERTN
  1.  Q:'$P($G(^ADEOPS(0)),U,3)
  1.  D RSLT^ADE697A("Dental Operative Site Changes")
  1.  F ADEJ=1:1:1 S ADERTN="^ADE6O"_ADEJ D
  1.  . F ADET=1:2 S ADELINE="S ADEFROM=$T(OPMOD+"_ADET_ADERTN_")" X ADELINE Q:$P(ADEFROM,";",3)="END"  S ADELINE="S ADETO=$T(OPMOD+"_(ADET+1)_ADERTN_")" X ADELINE D OPMOD(ADEFROM,ADETO)
  1.  . Q
  1.  Q
  1.  ;
  1. OPMOD(ADEFROM,ADETO)         ;
  1.  ;
  1.  ;ADEFROM and ADETO are in the form:
  1.  ;  ANATOMIC NAME^SYNONYM^MNEMONIC
  1.  ;
  1.  N ADEJ,ADE,ADEDA,ADEDIE,ADEDR,ADEY
  1.  F ADEJ=2:1:4 S ADE("FROM",ADEJ-1)=$P(ADEFROM,U,ADEJ),ADE("TO",ADEJ-1)=$P(ADETO,U,ADEJ)
  1.  D RSLT^ADE697A($J("",15)_ADE("FROM",3)_"---->"_ADE("TO",3))
  1.  S ADEDA=$O(^ADEOPS("B",ADE("FROM",3),0))
  1.  Q:'ADEDA
  1.  Q:'$D(^ADEOPS(ADEDA,0))
  1.  S ADEDIE="^ADEOPS("
  1.  S ADEDR=".01///"_ADE("TO",1)
  1.  S ADEDR=ADEDR_";8802///"_ADE("TO",2)
  1.  S ADEDR=ADEDR_";8801///"_ADE("TO",3)
  1.  S ADEY=$$DIE^ADE697A(ADEDIE,ADEDA,ADEDR)
  1.  I ADEY["ERR" D RSLT^ADE697A("ERROR: EDIT OPSITE FAILED => "_ADE("FROM",1)) Q
  1.  Q
  1.  ;
  1. GROUP ;EP Code Edit Group Mods
  1.  ;
  1.  N ADET,ADEFROM,ADETO,ADEJ,ADELINE,ADERTN
  1.  Q:'$P($G(^ADEDIT("GRP",0)),U,3)
  1.  D RSLT^ADE697A("Dental Code Group Changes")
  1.  D RSLT^ADE697A("  Converting to Primary Letter codes and Bar delimiters")
  1.  F ADEJ=1:1:1 S ADERTN="^ADE6G"_ADEJ D
  1.  . F ADET=1:2 S ADELINE="S ADEFROM=$T(OPMOD+"_ADET_ADERTN_")" X ADELINE Q:$P(ADEFROM,";",3)="END"  S ADELINE="S ADETO=$T(OPMOD+"_(ADET+1)_ADERTN_")" X ADELINE D GRPMOD(ADEFROM,ADETO)
  1.  . Q
  1.  Q
  1.  ;
  1. GRPMOD(ADEFROM,ADETO)        ;
  1.  ;
  1.  ;ADEFROM and ADETO are in the form:
  1.  ;  NAME^CODES
  1.  ;
  1.  N ADEJ,ADE,ADEDA,ADEDIE,ADEDR,ADEY
  1.  F ADEJ=2:1:4 S ADE("FROM",ADEJ-1)=$P(ADEFROM,U,ADEJ),ADE("TO",ADEJ-1)=$P(ADETO,U,ADEJ)
  1.  D RSLT^ADE697A($J("",15)_ADE("FROM",1)_"---->Converted")
  1.  S ADEDA=$O(^ADEDIT("GRP","B",ADE("FROM",1),0))
  1.  Q:'ADEDA
  1.  Q:'$D(^ADEDIT("GRP",ADEDA,0))
  1.  S ADEDIE="^ADEDIT(""GRP"","
  1.  S ADEDR=""
  1.  S ADEDR=ADEDR_"1///"_ADE("TO",2)
  1.  I ADE("TO",3)]"" S ADEDR=ADEDR_";4///"_ADE("TO",3)
  1.  S ADEY=$$DIE^ADE697A(ADEDIE,ADEDA,ADEDR)
  1.  I ADEY["ERR" D RSLT^ADE697A("ERROR: EDIT GROUP FAILED => "_ADE("FROM",1)) Q
  1.  Q
  1.  ;
  1. EDIT ;EP
  1.  ;Disable Sealant & prophy age limits, prophy and perio surgery edits
  1.  N ADEDJ,ADEDA,ADEDIE,ADEDR,ADEY,DA
  1.  D RSLT^ADE697A("  Modifying DENTAL EDIT entries.")
  1.  S ADEDIE="^ADEDIT("
  1.  S ADEDR="1.4///N"
  1.  F ADEDA=15,16,19,10,11,14,17,18 D
  1.  . S ADEY=$$DIE^ADE697A(ADEDIE,ADEDA,ADEDR)
  1.  ;
  1.  N T,L,ADEJ
  1.  D RSLT^ADE697A("Add New Data Entry Screens and Edits")
  1.  F ADEJ=1:1:1 S ADERTN="^ADE6E"_ADEJ D
  1.  . F T=1:1 S ADELINE="S L=$T(ADDEDIT+T"_ADERTN_")" X ADELINE S L=$P(L,";",3) Q:L="END"  D EDITADD(L)
  1.  . Q
  1.  ;Re-index file
  1. RENDX D RSLT^ADE697A("Re-indexing Dental Edit File")
  1.  K ^ADEDIT("AC"),^ADEDIT("AD")
  1.  S DA=0,DIK="^ADEDIT(" F  S DA=$O(^ADEDIT(DA)) Q:'+DA  D
  1.  . D IX^DIK
  1.  Q
  1.  ;
  1. EDITADD(L) ;
  1.  N ADEJ,N,Y,ADEDR
  1.  F ADEJ=2:1:8 S N(ADEJ-1)=$P(L,U,ADEJ)
  1.  I $D(^ADEDIT("AD",N(1),N(2))) D RSLT^ADE697A("NOT ADDED: CODE EDIT EXISTS => "_N(1)_" TYPE "_N(2)) Q
  1.  S ADEDR="1///"_N(2)
  1.  S ADEDR=ADEDR_";3///"_N(3)
  1.  S ADEDR=ADEDR_";4///"_N(4)
  1.  S ADEDR=ADEDR_";2///"_N(5)
  1.  S ADEDR=ADEDR_";2.4///"_N(6)
  1.  S ADEDR=ADEDR_";6///"_N(7)
  1.  S Y=$$FILE^ADE697A("^ADEDIT(",N(1),ADEDR,9002007.9)
  1.  D ADDFAIL^ADE697A(N(1)):Y<0,ADDOK^ADE697A(N(1)):Y>0
  1.  Q