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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTZZ 926 printed Dec 13, 2024@01:46:53 Page 2
DENTZZ ; HISC/NCA - Add the Entry EVALUATION ;4/1/96 10:04
+1 ;;1.2;DENTAL;**20**;Apr 15, 1996
+2 if $ORDER(^DENT(220.6,454,1,"B","EVALUATION",0))'<1
GOTO AD2
AD1 ; Add the first EVALUATION entry
+1 SET DENTIEN=$ORDER(^DENT(220.6,"B","DENTPERIU010",0))
if 'DENTIEN
GOTO AD2
+2 SET TXT="DY=5,DX=41"
SET TXT1="DY=5,DX=55"
SET NUM=41
DO ADD
+3 WRITE !!,"..."
AD2 ; Add the second EVALUATION entry
+1 if $ORDER(^DENT(220.6,439,1,"B","EVALUATION",0))'<1
QUIT
+2 SET DENTIEN=$ORDER(^DENT(220.6,"B","DENTPERIM010",0))
IF 'DENTIEN
KILL DENTIEN
QUIT
+3 SET TXT="DY=6,DX=41"
SET TXT1="DY=6,DX=55"
SET NUM=42
DO ADD
+4 WRITE "...Done"
QUIT
ADD ; Add the entry
+1 KILL DD,DO,DIC
SET DA(1)=DENTIEN
SET DIC(0)="L"
SET DIC="^DENT(220.6,"_DA(1)_","_1_","
SET DLAYGO=220.6
SET X="EVALUATION"
DO FILE^DICN
KILL DIC,DLAYGO
+2 SET DA=+Y
if 'DA
QUIT
+3 KILL DIE
SET DA(1)=DENTIEN
SET DIE="^DENT(220.6,"_DA(1)_","_1_","
+4 SET 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"
DO ^DIE
KILL DA,DENTIEN,DIE,DR,NUM,TXT,TXT1,X,Y
+5 QUIT
