- 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
