source: WorldVistAEHR/trunk/r/DENTAL-DEN/DENTZZ.m@ 836

Last change on this file since 836 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 908 bytes
RevLine 
[613]1DENTZZ ; HISC/NCA - Add the Entry EVALUATION ;4/1/96 10:04
2 ;;1.2;DENTAL;**20**;Apr 15, 1996
3 G:$O(^DENT(220.6,454,1,"B","EVALUATION",0))'<1 AD2
4AD1 ; Add the first EVALUATION entry
5 S DENTIEN=$O(^DENT(220.6,"B","DENTPERIU010",0)) G:'DENTIEN AD2
6 S TXT="DY=5,DX=41",TXT1="DY=5,DX=55",NUM=41 D ADD
7 W !!,"..."
8AD2 ; Add the second EVALUATION entry
9 Q:$O(^DENT(220.6,439,1,"B","EVALUATION",0))'<1
10 S DENTIEN=$O(^DENT(220.6,"B","DENTPERIM010",0)) I 'DENTIEN K DENTIEN Q
11 S TXT="DY=6,DX=41",TXT1="DY=6,DX=55",NUM=42 D ADD
12 W "...Done" Q
13ADD ; Add the entry
14 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
15 S DA=+Y Q:'DA
16 K DIE S DA(1)=DENTIEN,DIE="^DENT(220.6,"_DA(1)_","_1_","
17 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
18 Q
Note: See TracBrowser for help on using the repository browser.