PXICLN19 ;ISL/JVS - Cleanup for patch 19 ;1/2/97 11:00
;;1.0;PCE PATIENT CARE ENCOUNTER;**19**;Aug 12, 1996
;
;--REINTDEX PCE CODE MAPPING FILE AFTER PATCH 17
D BMES^XPDUTL("Reindexing 'PCE CODE MAPPING FILE' #811.1")
K ^PXD(811.1,"B")
K ^PXD(811.1,"AA")
;
S DIK="^PXD(811.1,"
D IXALL^DIK
K DIC,DIK,X
;--KILL DD OF #815
S DIU=815,DIU(0)="" D EN^DIU2
Q
POST ;--CHANGE ENTRY IN 811.1
D BMES^XPDUTL("Editing 'PCE CODE MAPPING FILE' #811.1")
S DA=$O(^PXD(811.1,"B","36;AUTTIMM(",0))
S DR=".02///^S X=90741"
S DIE="^PXD(811.1,"
D ^DIE
K X,DR,DIE,DIC1,DIC,DI,DA,D0,D,%Y,%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXICLN19 611 printed Dec 13, 2024@02:28:58 Page 2
PXICLN19 ;ISL/JVS - Cleanup for patch 19 ;1/2/97 11:00
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**19**;Aug 12, 1996
+2 ;
+3 ;--REINTDEX PCE CODE MAPPING FILE AFTER PATCH 17
+4 DO BMES^XPDUTL("Reindexing 'PCE CODE MAPPING FILE' #811.1")
+5 KILL ^PXD(811.1,"B")
+6 KILL ^PXD(811.1,"AA")
+7 ;
+8 SET DIK="^PXD(811.1,"
+9 DO IXALL^DIK
+10 KILL DIC,DIK,X
+11 ;--KILL DD OF #815
+12 SET DIU=815
SET DIU(0)=""
DO EN^DIU2
+13 QUIT
POST ;--CHANGE ENTRY IN 811.1
+1 DO BMES^XPDUTL("Editing 'PCE CODE MAPPING FILE' #811.1")
+2 SET DA=$ORDER(^PXD(811.1,"B","36;AUTTIMM(",0))
+3 SET DR=".02///^S X=90741"
+4 SET DIE="^PXD(811.1,"
+5 DO ^DIE
+6 KILL X,DR,DIE,DIC1,DIC,DI,DA,D0,D,%Y,%
+7 QUIT
