AUMDOPKG.m

AUMDOPKG ;IHS/OIRM/DSD/AEF - UPDATE AUM VERSION [ 12/03/1998   2:35 PM ]

 ;;99.1;ICD UPDATE;;DEC 03, 1998

 ;

 ;This routine updates the Package file with installation information

 ;for the AUM ICD Updates package

 ;

UPDATE ;EP -- UPDATE PACKAGE FILE

 ;

 N AUMDOTXT,DA,DD,DIC,DIE,DIK,DO,DR,IENS,X,Y

 D ^XBKVAR

 I $G(AUMDO("QUIT")) W !,"Did not update installation information in Package file",! Q

 S AUMDO("PKG IEN")=$O(^DIC(9.4,"C","AUM",0))

 I 'AUMDO("PKG IEN") D ADDPKG

 Q:'AUMDO("PKG IEN")

 S AUMDO("VER")=$P($T(AUMDOPKG+1),";",3)

 S DA=AUMDO("PKG IEN")

 S DIE="^DIC(9.4,"

 S DR="11.01////"_"IHS/OIRM/DIR"_";10////"_"IHS/OIRM/DIR/AEF"_";13////"_AUMDO("VER")_";11.1///"_"@"_";916///"_"@"_";916.5///"_"@"_";914///"_"@"_";914.5///"_"@"_";913///"_"@"_";913.5///"_"@"

 D ^DIE

 S DA(1)=DA

 S DIC=DIE_DA(1)_",22,"

 S DIC(0)="L"

 S DIC("P")=$P(^DD(9.4,22,0),U,2)

 S X=AUMDO("VER")

 K DD,DO

 D FILE^DICN

 Q:Y'>0

 S DA=+Y

 S DIE=DIC

 S DR="1///"_$P($T(AUMDOPKG+1),";",6)_";2////"_DT_";3////"_DUZ

 D ^DIE

 ;-----

 F I=1:1 S X=$P($T(TEXT+I),";",3) Q:X["$$END"  D

 . S AUMDOTXT(I,0)=X

 S IENS=AUMDO("PKG IEN")_","

 D WP^DIE(9.4,IENS,3,,"AUMDOTXT")

 ;-----

 S DA(1)=AUMDO("PKG IEN")

 S DIK="^DIC(9.4,"_DA(1)_",4,"

 S DA=0 F  S DA=$O(^DIC(9.4,DA(1),4,DA)) Q:'DA  D ^DIK

 ;-----

 S DIK="^DIC(9.4,"_DA(1)_",2,"

 S DA=0 F  S DA=$O(^DIC(9.4,DA(1),2,DA)) Q:'DA  D ^DIK

 ;-----

 S DIK="^DIC(9.4,"_DA(1)_",3,"

 S DA=0 F  S DA=$O(^DIC(9.4,DA(1),3,DA)) Q:'DA  D ^DIK

 Q

 ;

ADDPKG ;----- ADD AUM (ICD UPDATE) PACKAGE TO PACKAGE FILE

 ;

 N DA,DD,DIC,DIE,DO,DR,X,Y

 S DIC="^DIC(9.4,"

 S DIC(0)="L"

 S X="ICD UPDATE"

 K DD,DO

 D FILE^DICN

 Q:+Y'>0

 S AUMDO("PKG IEN")=+Y

 S DA=+Y

 S DIE=DIC

 S DR="1////"_"AUM"_";2////"_"AUMDO ICD Update Utility"

 D ^DIE

 Q

 ;

TEXT ;----- TEXT FOR PACKAGE DESCRIPTION FIELD OF PACKAGE FILE

 ;;The AUMDO utility provides the capability to update the IHS ICD

 ;;Operations and Procedures (ICD0) and ICD Diagnosis (ICD9) files with

 ;;new or changed ICD information.  The update date will reflect the

 ;;most current ICD Official Authorized Addenda distributed by the

 ;;American Medical Records Association.

 ;;  

 ;;All update actions to the ICD files are managed by the Division of

 ;;Information Resources, Office of Information Resources Management

 ;;in Albuquerque.

 ;;  

 ;;Distribution of updates will be done periodically and identified by

 ;;a version number.

 ;;$$END

 ;

RTNAME ;;AUMDOPKG

AUMDOPKG  ;IHS/OIRM/DSD/AEF - UPDATE AUM VERSION [ 12/03/1998   2:35 PM ]

 +1       ;;99.1;ICD UPDATE;;DEC 03, 1998

 +2       ;

 +3       ;This routine updates the Package file with installation information

 +4       ;for the AUM ICD Updates package

 +5       ;

UPDATE    ;EP -- UPDATE PACKAGE FILE

 +1       ;

 +2        NEW AUMDOTXT,DA,DD,DIC,DIE,DIK,DO,DR,IENS,X,Y

 +3        DO ^XBKVAR

 +4        IF $GET(AUMDO("QUIT"))

               WRITE !,"Did not update installation information in Package file",!

               QUIT 

 +5        SET AUMDO("PKG IEN")=$ORDER(^DIC(9.4,"C","AUM",0))

 +6        IF 'AUMDO("PKG IEN")

               DO ADDPKG

 +7        IF 'AUMDO("PKG IEN")

               QUIT 

 +8        SET AUMDO("VER")=$PIECE($TEXT(AUMDOPKG+1),";",3)

 +9        SET DA=AUMDO("PKG IEN")

 +10       SET DIE="^DIC(9.4,"

 +11       SET DR="11.01////"_"IHS/OIRM/DIR"_";10////"_"IHS/OIRM/DIR/AEF"_";13////"_AUMDO("VER")_";11.1///"_"@"_";916///"_"@"_";916.5///"_"@"_";914///"_"@"_";914.5///"_"@"_";913///"_"@"_";913.5///"_"@"

 +12       DO ^DIE

 +13       SET DA(1)=DA

 +14       SET DIC=DIE_DA(1)_",22,"

 +15       SET DIC(0)="L"

 +16       SET DIC("P")=$PIECE(^DD(9.4,22,0),U,2)

 +17       SET X=AUMDO("VER")

 +18       KILL DD,DO

 +19       DO FILE^DICN

 +20       IF Y'>0

               QUIT 

 +21       SET DA=+Y

 +22       SET DIE=DIC

 +23       SET DR="1///"_$PIECE($TEXT(AUMDOPKG+1),";",6)_";2////"_DT_";3////"_DUZ

 +24       DO ^DIE

 +25      ;-----

 +26       FOR I=1:1

               SET X=$PIECE($TEXT(TEXT+I),";",3)

               IF X["$$END"

                   QUIT 

               Begin DoDot:1

 +27               SET AUMDOTXT(I,0)=X

               End DoDot:1

 +28       SET IENS=AUMDO("PKG IEN")_","

 +29       DO WP^DIE(9.4,IENS,3,,"AUMDOTXT")

 +30      ;-----

 +31       SET DA(1)=AUMDO("PKG IEN")

 +32       SET DIK="^DIC(9.4,"_DA(1)_",4,"

 +33       SET DA=0

           FOR 

               SET DA=$ORDER(^DIC(9.4,DA(1),4,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +34      ;-----

 +35       SET DIK="^DIC(9.4,"_DA(1)_",2,"

 +36       SET DA=0

           FOR 

               SET DA=$ORDER(^DIC(9.4,DA(1),2,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +37      ;-----

 +38       SET DIK="^DIC(9.4,"_DA(1)_",3,"

 +39       SET DA=0

           FOR 

               SET DA=$ORDER(^DIC(9.4,DA(1),3,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +40       QUIT 

 +41      ;

ADDPKG    ;----- ADD AUM (ICD UPDATE) PACKAGE TO PACKAGE FILE

 +1       ;

 +2        NEW DA,DD,DIC,DIE,DO,DR,X,Y

 +3        SET DIC="^DIC(9.4,"

 +4        SET DIC(0)="L"

 +5        SET X="ICD UPDATE"

 +6        KILL DD,DO

 +7        DO FILE^DICN

 +8        IF +Y'>0

               QUIT 

 +9        SET AUMDO("PKG IEN")=+Y

 +10       SET DA=+Y

 +11       SET DIE=DIC

 +12       SET DR="1////"_"AUM"_";2////"_"AUMDO ICD Update Utility"

 +13       DO ^DIE

 +14       QUIT 

 +15      ;

TEXT      ;----- TEXT FOR PACKAGE DESCRIPTION FIELD OF PACKAGE FILE

 +1       ;;The AUMDO utility provides the capability to update the IHS ICD

 +2       ;;Operations and Procedures (ICD0) and ICD Diagnosis (ICD9) files with

 +3       ;;new or changed ICD information.  The update date will reflect the

 +4       ;;most current ICD Official Authorized Addenda distributed by the

 +5       ;;American Medical Records Association.

 +6       ;;  

 +7       ;;All update actions to the ICD files are managed by the Division of

 +8       ;;Information Resources, Office of Information Resources Management

 +9       ;;in Albuquerque.

 +10      ;;  

 +11      ;;Distribution of updates will be done periodically and identified by

 +12      ;;a version number.

 +13      ;;$$END

 +14      ;

RTNAME    ;;AUMDOPKG