DG5382PR ; ALBANY/GTS - DG*5.3*82 PRE-INIT; 2/01/96-10:15AM
;;5.3;Registration;**82**;Jan 30, 1996
;
MAIN ;
D RMVENT ;** Remove LINE multiple from EMBOSSED CARD TYPE file
Q
;
RMVENT ;** Remove LINE NUMBERs from WRISTBAND Entry in EMBOSSED CARD TYPE File
N DGECDA,DGECLNDA
S DIC="^DIC(39.1,",DIC(0)="M",X="WRISTBAND"
D ^DIC ;** Get WRISTBAND DA from file 39.1
S DGECDA=+Y
K DIC,X,Y
I DGECDA DO
.S DGECLNDA=0
.F S DGECLNDA=$O(^DIC(39.1,DGECDA,1,DGECLNDA)) Q:'DGECLNDA DO
..S DA=DGECLNDA,DA(1)=DGECDA,DIK="^DIC(39.1,"_DA(1)_",1,"
..D ^DIK
..K DIK,DA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG5382PR 588 printed Dec 13, 2024@02:38:56 Page 2
DG5382PR ; ALBANY/GTS - DG*5.3*82 PRE-INIT; 2/01/96-10:15AM
+1 ;;5.3;Registration;**82**;Jan 30, 1996
+2 ;
MAIN ;
+1 ;** Remove LINE multiple from EMBOSSED CARD TYPE file
DO RMVENT
+2 QUIT
+3 ;
RMVENT ;** Remove LINE NUMBERs from WRISTBAND Entry in EMBOSSED CARD TYPE File
+1 NEW DGECDA,DGECLNDA
+2 SET DIC="^DIC(39.1,"
SET DIC(0)="M"
SET X="WRISTBAND"
+3 ;** Get WRISTBAND DA from file 39.1
DO ^DIC
+4 SET DGECDA=+Y
+5 KILL DIC,X,Y
+6 IF DGECDA
Begin DoDot:1
+7 SET DGECLNDA=0
+8 FOR
SET DGECLNDA=$ORDER(^DIC(39.1,DGECDA,1,DGECLNDA))
if 'DGECLNDA
QUIT
Begin DoDot:2
+9 SET DA=DGECLNDA
SET DA(1)=DGECDA
SET DIK="^DIC(39.1,"_DA(1)_",1,"
+10 DO ^DIK
+11 KILL DIK,DA
End DoDot:2
End DoDot:1
+12 QUIT
