PXICLN19.m

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 ---PXICLN19   611     printed  Apr 09, 2024@21:33:13                                                                                                                                                                                                     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