AQAZPOST.m

AQAZPOST ;IHS/ORDC/LJF - POST INIT; [ 05/05/93  3:15 PM ]

 ;;1.0;QA PATCHES;;29 APR 93

 ;

TEMPLATE ; ** remove old print template from security key file

 S X=$O(^DIPT("B","AQAQSECURITY",0)) G FIND:X=""

 G FIND:$P($G(^DIPT(X,0)),U,4)'=19.1    ;wrong template

 S DA=X,DIK="^DIPT(" D ^DIK W !!,"Removing old print template . . .",!

 ;

FIND ; ** find package entry

 K DIC S DIC=9.4,DIC(0)="",D="C",X="AQAZ" D IX^DIC

 G EXIT:Y<0

 ;

DELETE ; ** delete entry from package file

 S DA=+Y,DIK="^DIC(9.4," D ^DIK

 ;

EXIT ; ** eoj

 W !!,"UPDATE COMPLETE!",!

 K DIC,D,X,Y,DA,DIK Q

AQAZPOST  ;IHS/ORDC/LJF - POST INIT; [ 05/05/93  3:15 PM ]

 +1       ;;1.0;QA PATCHES;;29 APR 93

 +2       ;

TEMPLATE  ; ** remove old print template from security key file

 +1        SET X=$ORDER(^DIPT("B","AQAQSECURITY",0))

           IF X=""

               GOTO FIND

 +2       ;wrong template

           IF $PIECE($GET(^DIPT(X,0)),U,4)'=19.1

               GOTO FIND

 +3        SET DA=X

           SET DIK="^DIPT("

           DO ^DIK

           WRITE !!,"Removing old print template . . .",!

 +4       ;

FIND      ; ** find package entry

 +1        KILL DIC

           SET DIC=9.4

           SET DIC(0)=""

           SET D="C"

           SET X="AQAZ"

           DO IX^DIC

 +2        IF Y<0

               GOTO EXIT

 +3       ;

DELETE    ; ** delete entry from package file

 +1        SET DA=+Y

           SET DIK="^DIC(9.4,"

           DO ^DIK

 +2       ;

EXIT      ; ** eoj

 +1        WRITE !!,"UPDATE COMPLETE!",!

 +2        KILL DIC,D,X,Y,DA,DIK

           QUIT