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

DENTZZ.m

Go to the documentation of this file.
  1. DENTZZ ; HISC/NCA - Add the Entry EVALUATION ;4/1/96 10:04
  1. ;;1.2;DENTAL;**20**;Apr 15, 1996
  1. G:$O(^DENT(220.6,454,1,"B","EVALUATION",0))'<1 AD2
  1. AD1 ; Add the first EVALUATION entry
  1. S DENTIEN=$O(^DENT(220.6,"B","DENTPERIU010",0)) G:'DENTIEN AD2
  1. S TXT="DY=5,DX=41",TXT1="DY=5,DX=55",NUM=41 D ADD
  1. W !!,"..."
  1. AD2 ; Add the second EVALUATION entry
  1. Q:$O(^DENT(220.6,439,1,"B","EVALUATION",0))'<1
  1. S DENTIEN=$O(^DENT(220.6,"B","DENTPERIM010",0)) I 'DENTIEN K DENTIEN Q
  1. S TXT="DY=6,DX=41",TXT1="DY=6,DX=55",NUM=42 D ADD
  1. W "...Done" Q
  1. ADD ; Add the entry
  1. K DD,DO,DIC S DA(1)=DENTIEN,DIC(0)="L",DIC="^DENT(220.6,"_DA(1)_","_1_",",DLAYGO=220.6,X="EVALUATION" D FILE^DICN K DIC,DLAYGO
  1. S DA=+Y Q:'DA
  1. K DIE S DA(1)=DENTIEN,DIE="^DENT(220.6,"_DA(1)_","_1_","
  1. S DR=".02////^S X=TXT;.03////^S X=10;.04////^S X=TXT1;.05////^S X=6.4;.06////^S X=""S"";.11////^S X=NUM" D ^DIE K DA,DENTIEN,DIE,DR,NUM,TXT,TXT1,X,Y
  1. Q