GECSPPRE ;WISC/RFJ-version 2 pre-init ;28 Jun 94
;;2.0;GCS;;MAR 14, 1995
N %,DA,DIC,DIK,X,Y
; remove AZ cross reference for field 9 (date created) in file 2100
; if the x-ref exists, remove the field, the init will re-install it
I $D(^DD(2100,0,"IX","AZ",2100,9)) S DIK="^DD(2100,",DA(1)=2100,DA=9 D ^DIK K ^GECS(2100,"AZ")
;
; remove C cross reference for field 9.1 (amis mo/yr) in file 2100
; if the x-ref exists, remove the field, the init will re-install it
I $D(^DD(2100,0,"IX","C",2100,9.1)) S DIK="^DD(2100,",DA(1)=2100,DA=9.1 D ^DIK K ^GECS(2100,"C")
;
; remove AT cross reference for field 2 (transmit y/n) in 2101.12
; if the x-ref exists, remove the field, the init will re-install it
I $D(^DD(2101.12,0,"IX","AT",2101.12,2)) D
. S DIK="^DD(2101.12,",DA(1)=2101.12,DA=2 D ^DIK
. S %=0 F S %=$O(^GECS(2101.1,%)) Q:'% K ^GECS(2101.1,%,2,"AT")
;
; clean up duplicates in file 2101.2
S GECSNAME="" F S GECSNAME=$O(^GECS(2101.2,"B",GECSNAME)) Q:GECSNAME="" S DA=$O(^GECS(2101.2,"B",GECSNAME,0)) Q:'DA F S DA=$O(^GECS(2101.2,"B",GECSNAME,DA)) Q:'DA S DIK="^GECS(2101.2," D ^DIK
;
; remove id from 2101.2 to prevent duplicates from being installed
K ^DD(2101.2,0,"ID",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSPPRE 1271 printed Dec 13, 2024@01:56:19 Page 2
GECSPPRE ;WISC/RFJ-version 2 pre-init ;28 Jun 94
+1 ;;2.0;GCS;;MAR 14, 1995
+2 NEW %,DA,DIC,DIK,X,Y
+3 ; remove AZ cross reference for field 9 (date created) in file 2100
+4 ; if the x-ref exists, remove the field, the init will re-install it
+5 IF $DATA(^DD(2100,0,"IX","AZ",2100,9))
SET DIK="^DD(2100,"
SET DA(1)=2100
SET DA=9
DO ^DIK
KILL ^GECS(2100,"AZ")
+6 ;
+7 ; remove C cross reference for field 9.1 (amis mo/yr) in file 2100
+8 ; if the x-ref exists, remove the field, the init will re-install it
+9 IF $DATA(^DD(2100,0,"IX","C",2100,9.1))
SET DIK="^DD(2100,"
SET DA(1)=2100
SET DA=9.1
DO ^DIK
KILL ^GECS(2100,"C")
+10 ;
+11 ; remove AT cross reference for field 2 (transmit y/n) in 2101.12
+12 ; if the x-ref exists, remove the field, the init will re-install it
+13 IF $DATA(^DD(2101.12,0,"IX","AT",2101.12,2))
Begin DoDot:1
+14 SET DIK="^DD(2101.12,"
SET DA(1)=2101.12
SET DA=2
DO ^DIK
+15 SET %=0
FOR
SET %=$ORDER(^GECS(2101.1,%))
if '%
QUIT
KILL ^GECS(2101.1,%,2,"AT")
End DoDot:1
+16 ;
+17 ; clean up duplicates in file 2101.2
+18 SET GECSNAME=""
FOR
SET GECSNAME=$ORDER(^GECS(2101.2,"B",GECSNAME))
if GECSNAME=""
QUIT
SET DA=$ORDER(^GECS(2101.2,"B",GECSNAME,0))
if 'DA
QUIT
FOR
SET DA=$ORDER(^GECS(2101.2,"B",GECSNAME,DA))
if 'DA
QUIT
SET DIK="^GECS(2101.2,"
DO ^DIK
+19 ;
+20 ; remove id from 2101.2 to prevent duplicates from being installed
+21 KILL ^DD(2101.2,0,"ID",2)
+22 QUIT
