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.
DENTZZ ; HISC/NCA - Add the Entry EVALUATION ;4/1/96  10:04
 ;;1.2;DENTAL;**20**;Apr 15, 1996
 G:$O(^DENT(220.6,454,1,"B","EVALUATION",0))'<1 AD2
AD1 ; Add the first EVALUATION entry
 S DENTIEN=$O(^DENT(220.6,"B","DENTPERIU010",0)) G:'DENTIEN AD2
 S TXT="DY=5,DX=41",TXT1="DY=5,DX=55",NUM=41 D ADD
 W !!,"..."
AD2 ; Add the second EVALUATION entry
 Q:$O(^DENT(220.6,439,1,"B","EVALUATION",0))'<1
 S DENTIEN=$O(^DENT(220.6,"B","DENTPERIM010",0)) I 'DENTIEN K DENTIEN Q
 S TXT="DY=6,DX=41",TXT1="DY=6,DX=55",NUM=42 D ADD
 W "...Done" Q
ADD ; Add the entry
 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
 S DA=+Y Q:'DA
 K DIE S DA(1)=DENTIEN,DIE="^DENT(220.6,"_DA(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
 Q